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I.  INTRODUCTION 

In  the  early  1960‘s,  when  database  processing  was  considered 
an  esoteric  subject,  data  was  organized  in  a  sequential  manner. 
Where  physical  structure  and  logical  structure  are  identical,  and 
data  were  sent  into  computer  as  batch  processing  without 

I 

real-time  access.  In  this  case,  multiple  copies  of  the  same  files  are 
!  kept.  At  that  time,  the  software  handled  the  I/O  operations.  If  the 

i 

physical  structure  changed,  application  programs  need  to  be 
rewritten,  recompiled  and  retested.  Data  was  designed  and 
optimized  for  a  single  application,  there  was  a  high  level  of 
program/data  dependence. 

I  Late  in  the  1960's,  both  serial  and  random  access  to  records 

!  was  possible.  The  logical  and  physical  layout  of  such  files  are 

distinct,  but  the  relationship  between  them  is  simple.  Now,  data 
storage  units  can  be  changed  without  changing  the  application 
program.  Data  structure  is  usually  designed  as  sequential,  indexed 
sequential,  or  simple  direct  access.  Multiple  key  retrieval  is 
generally  not  used.  Data  security  measures  can  be  used  but  are 
likely  to  be  very  elementary.  Still,  much  data  redundancy  exists. 
In  this  stage,  software  provides  data  access  methods  but  not  data 
management. 

In  the  early  1970's,  multiple  logical  files  can  be  derived  from 
the  same  data,  and  those  data  can  be  accessed  in  different  ways 
by  applications  with  different  requirements.  Data  elements  are 
shared  between  diverse  applications.  The  absence  of  redundancy 
facilitates  data  integrity.  Application  storage  organization  is 
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independant  of  the  application  program.  It  can  be  changed  to 
improve  database  performance  without  affecting  application 
programs.  Multiple  key  retrieval  can  be  used  where  complex  of 
programs.  The  program  in  this  study  written  in  the  Appie  Pascal 
data  organization  are  used  without  complicating  application 
language  (see  Appendix  A)  falls  into  this  category. 

Now,  at  the  current  stage  of  database  processing,  software 
provides  logical  as  well  as  physical  data  independence.  Data  can 
evolve  without  incurring  high  maintenance  costs.  Utilities  are 
provided  so  that  a  database  administrator  can  act  as  controller  and 
custodian  of  the  data  to  insure  that  its  organization  is  least  for  the 
users  as  a  whole.  Effective  procedures  are  provided  for  controlling 
privacy,  security  and  integrity  of  the  data.  With  these,  the 
database  can  easily  provide  answers  to  unanticipated  requests. 
More  than  that,  a  data  description  language  is  provided  for  the 
database  administrator.  Also,  a  command  language  exists  for  the 
application  programs,  and  a  query  language  exists  for  the  casual 
user.  The  dBASE  III  PLUS  language  (see  Appendix  B)  falls  into  this 
category. 

An  amazing  amount  of  progress  has  been  made  in  the  computer 
field  since  the  primitive  computer  age  of  the  1950s.  Personal 
computers,  high-level  languages,  artificial  intelligence,  and  many 
other  technological  advancements  have  been  made  in  a  period  of 
only  35  years,  and  new  appliactions  are  being  discovered  every 
day 

The  idea  or  recording  and  maintaining  information  m  an 
organized  manner  appeared  many  years  ago,  when  the  value  of 
organized  information  was  realized.  The  importance  of  this  idea  is 
stressed  m  the  Spinoza  expression  "The  order  and  connection  of 
ideas  is  the  same  as  the  order  and  connection  of  things".  However, 


the  appearance  of  computers  started  enforcing  this  idea  with  the 
implementation  of  applications  on  the  computer. 

The  use  of  automation  and  parallelism  theories  has  also  helped 
the  designers  to  make  retrieval  of  very  large  databases  very  easy, 
and  in  extremely  timely  manner. 

The  tremendous  progress  in  the  database  design  has  resulted  in 
lower  cost,  and  has  provided  a  strong  motivation  for  working  in 
the  database  develpoment  field,  especially  on  every  large  database. 

An  additionally  strong  motivation  for  working  in  the  database 
field  is  the  wide  variety  of  database  applications.  These  applications 
include  manufacturing  with  inventory  management,  the  servicing 
of  industries  with  lists  of  service  capabilities;  economic  models  with 
production  data  for  allocation  and  planning,  and  medical  services 
with  patient  records,  disease  histories,  problem  classification,  and 
treatment  effectiveness  data.  Thus,  database  are  appearing  and 
supporting  almost  every  science.  It  might  be  said  that  it  is  the 
database  era  in  computer  application. 

An  important  consideration  in  the  design  of  the  database  is  the 
way  of  storing  data,  which  is  used  for  a  broad  variety  of 
application  and  can  be  used  to  make  changes  to  the  data  quickly 
and  easily.  The  ability  of  the  database  to  be  applicable  in  so  broad 
an  aspect  of  applications  is  based  on  a  common  feature  that  makes 
database  development  valuable  and  general  in  a  programming 
methodology.  This  feature  is  a  creative  form  which  is  called 
"structural  growth".  This  "structural  growth"  should  start  with  a 
solution  on  a  simplified  version  of  the  problem  and  then  repeatedly 
expand  its  capabilities  up  to  desired  level. 

Database  systems  are  now  available  on  machines  that  range  all 
the  way  from  quite  small  microcomputers  to  the  largest 
mainframes.  The  facilities  provided  by  any  given  system  are  to 
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some  extent  determined  by  the  size  and  power  of  the  underlying 
machine. 

Following  will  be  the  detailed  discussion  of  both  the  old  program 
written  in  Apple  Pascal  which  ran  on  Apple  II  PLUS,  and  the  new 
program  written  in  dBASE  III  PLUS  which  is  going  to  run  on  IBM 
PC,  followed  by  a  study  of  the  maintainability  and  modifiability  of 
these  two  programs. 


II. 


A.  INTRODUCTION 

The  development  of  Pascal  began  in  1968  and  resulted  in  a 
compiler  written  entirely  in  Pascal  in  1970  by  Professor  Nicklaus 
Wirth  of  Zurich,  Switzerland.  The  language  was  slightly  revised  in 
1972  and  is  undergoing  standardization  efforts.  It  has  become  very 
popular  as  a  language  for  teaching  programming  and  is  widely  used 
on  microcomputers.  Its  popularity  is  due  to  the  fact  that  its 
syntax  is  relatively  easy  to  learn.  Also,  Pascal  facilitates  -writing 
structured  programs  -  programs  that  are  relatively  easy  to 
read,  understand,  and  maintain.  It  is  an  Algol- like  language,  but 
unlike  Algol's  key  words,  Pascal’s  reserved  words  are  not  typed 
differently  from  identifiers. 

In  Algol,  there  are  three  primitive  data  types,  and  Booleans. 
These,  in  turn,  were  very  similar  to  the  primitive  data  types 
provided  by  FORTRAN.  This  reflects  the  fact  that  both  of  these 
languages  are  predominantly  scientific  programming  languages. 
Numbers  and  logical  values  are  the  most  useful  objects  for 
scientific  programming.  Pascal  extends  its  applicability  to 
commercial  and  systems  programming  by  providing  one  additional 
primitive  data  type,  CHARACTERS.  Pascal  is  a  third  generation 
language,  and  a  reaction  to  the  second  generation  languages.  Its 
emphasis  is  on  simplicity  and  efficiency.  There  are  two  similar 
standards  for  Pascal.  They  are  ANSI/IEEE  (American  National 
Standards  Institute/Institute  for  Electrical  and  Electronics 
Engineers)  Standard,  and  ISO  Inter-  national  Standard. 

Although  Pascal  was  intended  as  a  teaching  language,  many 
other  programmers  have  found  that  it  is  also  suitable  for  "rear 
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programming.  Its  strong  typing  simplifies  debugging  and  helps 
catch  latent  errors  in  production  programs;  Its  rich  set  of  efficient, 
high  level  data  types  simplifies  many  non-numeric  programs;  and 
its  small  size  means  that  a  programmer  can  acquire  mastery  of 
the  language  in  a  moderate  amount  of  time. 

These  qualities  have  made  Pascal  an  attractive  vehicle  for 
programming  research.  Pascal  has  been  extended  for  concurrent 
programming,  to  support  verification,  and  for  operating  system 
writing,  or  even  a  database  writing  (the  original  program  in  this 
thesis  is  a  good  example  of  it).  Pascal  has  become  a  basis  for 
almost  all  new  language  designs;  most  new  languages  are 
“Pascal-like."  This  includes  the  language  Ada. 

B.  NAME  AND  CONTROL  STRUCTURES 

Pascal  includes  important  additions  to  Algol’s  name,  data,  and 
control  structuring  mechanisms.  Variable  declarations  are 
introduced  by  the  word  var  and  have  the  syntax: 

<names>  :  <type> 

Procedure  and  function  declarations  are  quite  similar  to  Algol’s, 
except  that  the  begin  comes  after  the  local  declarations  rather 
than  before  them: 

procedure  <name>  (  <formals>  ); 

<  declarations  > 
begin 

<  statements  > 

end; 

In  addition  to  variable  and  procedure  declarations,  Pascal  has 
constant  and  type  bindings.  Variables  can  declared  to  be  the  type 
of  a  range  of  integer.  This  new  data  type  then  can  be  used  in 
other  data  types.  Type  declarations  are  introduced  by  the  word 


type  and  have  the  syntax: 

<  name  >  =  <  type  > 

Pascal  has  added  a  character  data  type  for  nonnumeric 
programming  and  a  variety  of  data  type  constructors  for  arrays, 
records,  sets,  pointers,  and  so  forth.  Programmers  can  use  these, 
in  conjunction  with  type  declarations,  to  design  data  types 
specifically  suited  to  their  applications.  In  the  program  HANAOKA, 
a  lot  of  these  techniques  are  used. 

Pascal's  control  structures  incorporate  many  of  the  ideas  of 
structured  programming.  Of  course  the  if-then-else  and  for-loop 
(in  a  very  simplified  form)  are  provided.  Pascal  also  provides 
leading  and  trailing  decision  loops  and  a  case-statement  for 
handling  the  breakdown  of  a  problem  into  many  cases.  The  goto  is 
provided  in  a  simplified  form. 

C.  DATA  STRUCTURES 

Pascal  inherits  the  three  primitive  data  types  from  Algol:  reals, 
integers,  and  Booleans.  These  are  considered  to  be  the  standard 
data  types  (or  simple  data  types)  of  Pascal. 

l.  Real  and  Integer 

The  data  types  INTEGER  and  REAL  are  used  to  represent 
numeric  information.  People  use  INTEGER  variables  as  loop  counters 
and  to  represent  data  such  as  an  exam  score  or  those  without 
decimal  point.  The  data  type  REAL  can  be  used  to  represent  all 
numbers,  as  a  matter  of  fact,  INTEGER  is  a  subset  of  REAL.  On 
many  computers  though  operations  involving  integers  are  faster 
and  less  storage  space  is  needed  to  store  integers.  Also  operations 
with  integers  are  always  precise  whereas  there  may  be  some  ioss 
of  accuracy  when  dealing  with  real  numbers. 


These  differences  result  from  the  way  real  numbers  and 
integers  are  represented  internally  in  memory,  real- numbers  tend 
to  be  computer  dependent;  some  sample  integer  and  real  formats 
are  shown  in  Fig.  2-1. 


integer  format  real  format 


binary  number 

mantissa 

exponent 

Figure  2-1  Integer  and  Real  Format 


In  Fig.  2-1,  each  integer  is  represented  as  a  standard  binary 
number  Real  format  is  analogous  to  scientific  notation.  The  storage 
area  occupied  by  a  real  number  is  divided  into  two  sections:  the 
mantissa  and  the  exponent.  All  the  arithmetic  operators 
(+,-,*,/)  seen  so  far  can  be  used  with  either  integer  or  real 
operands.  But  the  two  operators,  div  and  mod,  that  must  be  used 
only  with  type  INTEGER  operands.  With  these  operators,  we  can 
write  multiple-operator  expressions  that  compute  the  desired 
results. 


2.  Boolean  Variables.  Expressions  and  Operators 

A  BOOLEAN  variable  or  constant  can  be  set  to  either  of  the 
BOOLEAN  values,  TRUE  or  FALSE.  The  statement 

const 

GOOD  =  TRUE; 

specifies  that  the  BOOLEAN  constant  GOOD  has  the  vaiue  TRUE.  We 
can  use  the  relational  operators  (=,  <,  >,  etc.)  with  numeric 
data  to  form  conditions  or  BOOLEAN  expressions.  There  are  three 
BOOLEAN  operators:  and,  or,  not.  These  operators  are  used  with 
operands  that  are  BOOLEAN  expressions.  BOOLEAN  variables  can  be 
used  as  program  flags  to  signal  whether  or  not  a  special  event 


occurred  in  a  program.  The  fact  that  such  an  event  occurred  is 
important  to  the  future  execution  of  the  program.  A  BOOLEAN 
variable  used  as  a  program  flag  is  initialized  to  one  of  its  two 
possible  values  (TRUE  or  FALSE)  and  reset  to  the  other  as  soon  as 
the  event  being  monitored  occurs. 

3.  Characters  Variables 

Pascal  provides  a  character  data  type  that  can  be  used  for 
the  storage  and  manipulation  of  the  individual  characters  that 
comprise  a  person's  name,  address,  etc.  Character  variables  are 
declared  using  the  data  type  CHAR  in  a  declaration.  A  character 
value  consists  of  a  single  printable  character  (letter,  digit, 
punctuation  mark,  etc.)  enclosed  in  apostrophes.  A  character 
value  can  be  assigned  to  a  character  variable  or  associated  with  a 
constant  identifier. 

Relational  operators  can  be  used  with  characters.  For 
example,  the  BOOLEAN  expressions 

SENTENCE  =  BLANK 
SENTENCE  <>  PERIOD 

are  used  to  determine  whether  two  character  variables  have  the 
same  value  or  different  values.  Order  comparisons  can  also  be 
performed  on  character  variables  using  the  relational  operators  <, 
<=,  >,  >= 

4.  Programmer- Defined  Data  Types 

One  of  the  features  of  Pascal  that  accounts  for  its  widespread 
use  is  that  it  permits  the  declaration  of  new  data  types.  In  Pascal, 
you  can  define  enumerated  types,  subrange  types  and  set 
types 


Often  programs  must  manipulate  nonnumeric  data;  this  is 


usually  character  data,  but  it  can  also  be  more  abstract.  For 
example,  a  commercial  data- processing  program  may  need  to  be 
able  to  deal  with  days  of  the  week.  With  enumerated  types  we 
can  construct  types  by  enumerating,  or  listing,  ail  their  possible 
values.  For  example,  we  can  declare  the  types  for  months,  days 
of  the  week,  and  sexes  like  this: 

type 

month  =  (Jan,  Feb,  Mar,  Apr,  May,  Jun,  Jul,  Aug,  Sep,  Oct, 

Nov,  Dec); 

DayOfWeek  =  (Sun,  Mon,  Tue,  Wen,  Thu,  Fri,  Sat); 

sex  =  (male,  female); 


It  is  then  possible  to  declare  variables  of  these  types  and  use 


them: 


var 

today,  tommorow  :  DayOfweek; 
ThisMonth  :  month; 
gender  :  sex; 

begin 


today  :=  Tue; 
today  :=  tommorow; 
ThisMonth  :=  Apr; 
gender  :=  female; 


Pascal  also  preserves  security  by  preventing  the  programmer 
from  performing  meaningless  operations  on  enumeration  values. 
People  use  abstract  data  type:  a  set  of  data  values  and  the 
primitive  operations  on  those  data  values.  For  an  enumerated  ype, 
the  set  of  data  values  are  specified  in  the  enumeration.  The 
operations  don't  have  to  be  specified  because  they  are  the  same  for 
all  enumerated  types: 


=,  succ,  pred 


The  ordering  relations  (<,>,  etc.)  are  defined  according  to  the 
order  specified  in  the  declaration  of  the  enumerated  type.  For 
example,  Mon  <  Wen  and  Dec  >  Jan.  The  succ  and  pred  functions 
give  the  succeding  and  preceding  elements  in  the  list.  For  example, 
succ(Mon)  =  Tue  and  pred  (Mar)  =  Feb.  These  operations  are  also 
secure;  for  example,  succ(Sat)  and  pred(Jan)  are  errors. 

The  benefits  of  enumerated  types  can  be  summaried  as 
followed: 

1.  They  are  high  level  and  application  oriented. 

2.  They  allow  programmers  to  say  what  they  mean. 

3.  They  are  efficient  since  they  allow  the  compiler  to 
economize  on  storage,  and  the  operations  can  be 
performed  quickly. 

4.  They  are  efficient  since  the  compiler  ensures  that 
programmer  can't  do  meaningless  operations. 

We  have  seen  that  the  enumerated  type  improves  security 
since  the  compiler  can  check  if  the  programmer  is  doing  something 
meaningless,  such  as  asking  for  the  successor  of  the  last  element 
in  the  enumeration.  The  Pascal  subrange  type  constructor 
extends  this  checking  to  integers  and  allows  tighter  checking  on 
other  types.  Suppose  the  variable  DayOf Month  is  used  to  hold 
meaningful  values  from  1-31.  although  this  could  be  declared  as  an 
integer  variable,  our  program  will  be  more  secure  if  we  use  a 
subrange  type: 

var  DayOfMonth  :  1..31; 

If  we  attempt  to  assign  to  this  variable  a  value  outside  this  range, 
we  will  get  an  error. 

Subrange  declarations  also  allow  the  the  compiler  to 
economize  on  storage  utilization.  Subrange  types  can  be  based  on 
types  other  than  integers. 

type  WeekDay  =  Mon. .  Fri; 


If  we  accidently  assigned  Sat  or  Sun  to  a  variable  of  type 
WeekDay,  we  would  get  an  error.  Also,  Pascal  permits  the 
programmer  to  define  subranges  of  any  discrete  type,  that  is, 
enumerated  types,  integers,  and  characters.  It  does  not  permit 
defining  a  subrange  of  the  real  numbers,  which  is  a  continuous 
type. 

5.  Set  Types 

Pascal  provides  the  ability  to  manipulate  small  finite  sets 
using  the  standard  operations  of  set  theory.  The  set  type  is  almost 
an  ideal  data  type.  It  is  high  level  and  application  oriented  yet 
very  efficient. 

The  description  of  a  set  type  has  the  form 
set  of  <  simple  type  > 

where  a  <slmple  type>  is  an  enumerated  type  (including  char),  a 
subrange  type,  or  a  name  of  one  of  these.  An  existing  set  can 
be  modified  using  the  set  operators.  Before  a  set  can  be 
manipulated,  its  initial  elements  must  be  defined  using  a  set 
assignment  statement.  A  set  variable  must  always  be  Initialized 
before  it  can  be  used  with  any  of  the  set  operators.  The  set 
operators  union,  intersection,  and  difference  require  two  sets  of  the 
same  type  as  operands.  The  +,*,  and  -  are  treated  as  set  operators 
when  their  operands  are  sets.  These  operators  can  be  used  to 
combine  two  sets  to  form  a  third  set.  If  more  than  one  set 
operator  is  used  in  an  expression,  the  normal  precedence  rules  tor 
the  operators  +,*,  and  -  will  be  followed.  When  m  doubt,  it  is  best 
to  use  parentheses  to  specify  the  intended  order  of  evaluation. 

Sets  may  also  be  compared  through  the  use  of  the  relational 
operators  =,  <=,  etc.  Both  operands  of  a  set  relational  operator 
must  have  the  same  base  type. 
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6. 


Pascal  is  descendant  of  Algol-60,  and  Algol-60  generalizes 
FORTRAN  arrays  in  two  respects:  It  allows  any  number  of 
dimensions  and  it  allows  lower  bounds  other  than  one.  Pascal  has 
generalized  Algol's  arrays  in  some  respects  and  has  restricted  them 
in  others. 

One  of  the  generalizations  is  in  the  allowable  index  types. 
They  can  be  subscripted  by  many  other  types  including  characters, 
enumerated  types,  and  subranges  of  these. 

var  A  :  array  [1..100]  of  real; 

Notice  that  the  dimensions  of  the  array  have  been  specified 
as  a  subrange  of  the  integers.  Actually,  any  finite  discrete  type 
can  be  used  as  an  index  type. 

Another  way  in  which  Pascal  generalizes  Algol  arrays  is  in 
the  allowable  element  types.  Now  any  type  can  be  the  base  type  of 
an  array  type.  That  is,  we  can  have  arrays  of  integers,  reals, 
characters,  enumerated  types,  subranges,  records,  pointers,  and  so 
forth.  In  general,  a  Pascal  array- type  constructor  has  the  form 
array  [  <index  type>  ]  of  <base  type> 

Where  <lndex  type>  is  any  finite  discrete  type  and  <base  typo  is 
any  type  at  all.  Thus,  Pascal  arrays  can  be  considered  finite 
mapping  from  the  index  type  to  the  base  type. 

Arrays  can  be  defined  as  multidimensional  arrays.  Suppose 
we  need  a  20X100  arrays  of  reals  M,  we  can  define 

var  M  :  array  [1..20]  of  array  [1..100]  of  real; 

As  mentioned  above,  the  base  type  of  an  array  can  be  any  type, 
including  another  array  type. 
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7.  Record  Types 

One  of  the  most  important  data  structure  constructors 
provided  by  Pascal  is  the  record- type  constructor.  This  is  a 
data  structure  that  allows  arbitrary  groups  of  data, 
type  person  =  record 

name  :  string; 
age  :  18.. 100; 
rank  :  string; 
sex  :  (male,  female) 
birthdate  :  date; 
end; 

Just  like  an  array,  a  record  has  a  number  of  components.  Unlike 
an  array,  however,  the  components  of  a  record  can  be  of  different 
types.  Also  the  components  of  records  can  themselves  be  complex 
data  types.  The  components  of  arrays  are  selected  by  subscripting. 
A  component  of  a  record  is  selected  by  placing  a  period  between 
the  name  of  the  record  and  the  name  of  the  component.  Selectors 
for  records  and  arrays  can  be  combined  as  needed  to  access  a 
particular  component.  But  why  have  both  arrays  and  records  since 
they  are  both  methods  of  grouping  data  together.  They  differ  in 
two  important  respects.  Arrays  are  homogeneous,  that  is,  ail  of 
the  components  of  an  array  are  the  same  type.  Records  are 
heterogeneous,  that  is,  their  components  do  not  have  to  be  the 
same  type.  In  this  sense  records  are  more  general  than  arrays. 

Since  arithmetic  and  logical  operations  must  be  performed 
on  individual  memory  cells,  record  variables  cannot  be  used  as  the 
operands  of  arithmetic  and  relational  operators.  These  opeartors 
must  be  used  with  individual  fields  of  a  record. 

The  other  difference  between  arrays  and  records  ,s  in  their 
manner  of  selecting  components.  We  can  select  specific  array 
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elements  with  expressions  like  A[l],  A  [2]  just  as  we  can  select 
specific  record  components  with  expressions  like  R.mon,  R.day.  The 
difference  is  that  we  can  compute  the  selector  to  be  used  with 
arrays;  that  is  we  can  write  A[E]  where  E  is  an  expression  whose 
value  will  be  known  at  run-time.  This  is  an  important  feature 
since  it  allows  writing  a  loop  that  process  all  the  elements  of  an 
array.  This  can't  be  done  with  records. 

8.  Pointer  Types 

Pointer  types  are  dynamic  data  structure  of  Pascal.  Dynamic 
data  structures  are  data  structures  that  "grow"  as  a  program 
executes.  A  dynamic  data  structure  Is  a  collection  of  elements 
(called  nodes)  that  are  normally  records.  Unlike  an  array  that 
always  contains  storage  space  for  a  fixed  number  of  elements,  a 
dynamic  data  structure  expands  and  contracts  during  program 
execution  based  on  the  data  storage  requirements  of  the  program. 

Dynamic  data  structures  are  used  for  storage  of  real  world 
data  that  is  constantly  changing.  An  example  would  be  an  airline 
passenger  list. 

Dynamic  data  structures  are  extremely  flexible.  It  is 
relatively  easy  to  add  new  information  by  creating  a  new  node  and 
Inserting  it  between  two  existing  nodes.  It  is  also  relatively  easy  to 
modify  dynamic  data  structures  by  removing  or  deleting  an 
existing  node.  This  is  more  convenient  than  modifying  an  array  of 
records,  where  each  record  is  in  a  fixed  position  relative  to  the 
others  as  determined  by  its  subscript.  Here  is  an  example  using 
this  feature: 

var  p  pointer; 
x  :  integer; 

begin 

new(p); 
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This  program  allocates  a  memory  location  and  puts  its 
address  In  P,  stores  5  in  the  memory  location  whose  address  is  in 
P,  and  then  add  the  contents  of  this  location  to  x. 

Since  we  don’t  know  beforehand  the  order  or  number  of 
nodes  in  a  dynamic  data  structure,  we  cannot  allocate  storage 
from  a  dynamic  data  structure  in  the  conventional  way  (using  a 
variable  declaration  statement).  Instead,  we  must  allocate  storage 
for  each  individual  node  as  needed  and  Join  this  node  to  the  rest  of 
the  structure.  The  new  statement  is  used  to  allocate  storage  for  a 
new  node. 

Also  we  must  have  some  way  of  referencing  each  new  node 
that  is  allocated  in  order  to  store  data  in  it.  Pascal  provides  a 
special  type  of  variable,  called  a  pointer  variable  (or  pointer), 
for  this  purpose. 

There  are  four  kinds  of  dynamic  data  structures  use  pointers 
in  Pascal.  They  are  :  linked  lists,  stacks,  queues,  and  trees.  A 
linked  list  or  simply  list  is  a  sequence  of  nodes  in  which  each 
node  is  linked  or  connected  to  the  node  following  it.  Each  node  in 
the  list  has  two  fields  :  the  first  field  contains  data  and  the  second 
field  is  a  pointer  to  the  next  list  element. 

A  stack  can  be  thought  of  as  a  linked  list  in  which  each  new 
node  is  inserted  at  the  head  of  the  list  and  each  deletion  removes 
the  current  head  of  the  list.  Inserting  a  node  is  a  push  operation 
and  deleting  a  node  is  popping  the  stack. 

A  queue  is  a  linked  list  used  to  model  things  such  as  a  line  of 
customers  waiting  at  a  checkout  counter  or  a  stream  of  jobs 


waiting  to  be  printed  by  a  line  printer.  In  a  queue,  all  insertions 
are  done  at  one  end  (the  rear  of  the  queue)  and  all  deletions  are 
made  from  the  other  end  (the  front  of  the  queue). 

So  far  we  have  involved  list  elements  or  nodes  with  a  single 
pointer  field.  It  is  possible  to  have  lists  of  elements  with  more  than 
one  link.  We  call  it  a  multiply- linked  list. 


Figure  2-2  A  Sample  of  Multiply-linked  List 


A  special  kind  of  multiply- linked  list  that  has  wide 
applicability  in  computer  science  is  a  data  structure  called  a 
binary  tree.  (See  Figure  2-3) 

The  details  of  binary  tree  and  traverse  or  search  of  a  binary 
tree  are  subjects  of  Data  Structure,  to  go  further  into  them  please 
reference  Data  Structure  text  books. 
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Figure  2-3  A  Sample  Tree 


D.  SUMMARY 

Pascal’s  primary  goal  was  to  be  a  good  language  for  teaching 


programming.  This  led  to  subsidiary  goals  for  reliability,  simplicity, 
and  efficiency.  Pascal  has  been  very  successful  in  these  areas. 

Pascal  is  a  particular  suitable  language  with  which  to  learn 
programming.  Most  modern  programming  concepts  are  available  in 
Pascal.  In  sharp  contrast  to  BASIC,  things  become  much  more 
complex  as  programs  grow  in  size.  Pascal  programs,  by  contrast, 
expand  gracefully.  The  concepts  we  learn  with  Pascal  are  applicable 
in  almost  any  programming  environment. 

Much  of  the  criticism  Pascal  has  received  results  from  trying  to 
use  it  for  purposes  for  which  it  was  not  designed.  For  example, 
Pascal  has  been  criticized  for  its  lack  of  a  separate  compilation 
facility,  even  though  such  a  facility  is  not  especially  important  in 
teaching  programming  (the  language's  intended  application). 
Indeed,  it  is  to  Pascal's  credit  that  it  has  been  so  successfully 
applied  in  so  many  areas  for  which  it  was  not  intended. 


A.  AN  OVERVIEW  OF  dBASE  III  PLUS 

A  database  Is  a  central  repository  of  related  Information.  To 
paraphrase  this,  a  database  Is  a  physical  grouping  of  a  collection  of 
individual,  but  related,  bits  and  pieces  of  information.  The 
difficulty  in  building  an  effective  database  system  is  not  in  the 
mechanics  of  construction,  but  in  the  intelligent  design  and 
planned  use  of  the  database. 

As  an  example,  if  one  wants  to  maintain  information  about 
each  and  every  individual  employed  in  an  organization,  it  is 
necessary  to  create  a  base  of  data  about  all  the  employees.  This 
base  of  data  could  contain,  for  example,  information  about  each 
employer's  employee- number,  name,  salary,  year  of  hire,  and 
date  of  last  promotion.  This  base  will  subsequently  provide 
immediate  access  to  the  type  of  information  sought.  Database  can 
and  are  being  maintained  for  every  subject  from  astronomy  to 
zoology.  Computers,  because  of  their  speed  and  accuracy,  are  the 
information  processor,  the  physical  means,  of  creating  and 
subsequently  accessing  these  databases. 

dBASEUI  PLUS  is  defined  as  a  relational  database  manager,  that 
is,  this  software  helps  create  and  maintain  a  relational  database.  A 
relational  database  is  one  in  which  the  data  is  arranged  in  the 
form  of  a  matrix,  with  the  rows  of  the  matrix  forming  each 
individual  record  in  the  database,  and  the  columns  of  the  matrix 
forming  the  individual  fields  of  information.  Using  such  a  database, 
one  can  establish  a  relationship  between  two  or  more  databases,  by 
using  a  common  Key  field  of  information. 


B.  THE  dBASE  III  PLUS  SYSTEM 

So  where  does  dBASE  III  PLUS  fit  in  with  all  of  the  previous 
concepts  and  definitions? 

dBASE  III  PLUS  is  the  name  of  a  software  package  marketed  by 
Ashton  Tate, Inc.,  of  Culvery  City,  California;  it  is  a  very  powerful 
tool  for  the  development  of  microcomputer  business  applications. 
dBASEIII  PLUS  is  a  data  manager.  It  is  a  piece  of  software  that  lets 
the  user  have  full  freedom  in  the  conceptualization  and  creation  of 
database  for  all  types  of  business  applications.  Since  business 
depends  on  timely  information  dissemination,  the  value  of  a 
powerful,  programmable  utility  for  database  generation, 
maintenance,  and  query  cannot  be  overstated.  dBASE  III  PLUS  is 
defined  as  a  relational  database  manager,  that  is,  this  software 
helps  create  and  maintain  a  relational  database.  dBASE  III  PLUS 
can  be  executed  on  a  variety  of  microcomputers,  under  any  one  of 
the  popular  operating  systems. 

C.  DATA  TYPES  OF  dBASE  III  PLUS 

Data  is  defined  as  something  known  or  assumed;  facts  from 
which  a  conclusion  can  be  inferred.  Data  usually  represents  some 
aspect  of  the  physical  world  around  us,  such  as  a  list  of  names  and 
addresses,  the  temperarure  of  the  room,  today's  date  and  time,  or 
a  bank  statement. 

A  data  type  is  a  high  level  representation  of  data  as  seen  by  the 
user  which  has  a  corresponding  binary  form  understood  by  the 
computer.  Data  types  allow  people  to  write  programs  using  data 
representations  with  which  they  are  comfortable.  The  high  level 
representation  is  maintained  internally  as  a  binary  format 
processed  by  the  computer 

Each  language  provides  a  limited  number  of  elementary  data 


types.  Complex  data  structures  can  be  constructed  from  the 
elementary  types.  dBASE  III  PLUS  provides  Character, 

Numeric,  Logical,  Date,  and  Memo.  Using  these  data  types, 
complex  data  structures  useful  in  representing  a  multitude  of  real 
world  situations  can  be  constructed. 


1.  Character  Data  Type 

A  field  defined  as  a  character  field  accepts  any  character 
of  data  entered.  Character  data  is  used  to  represent  letters  of  the 
alphabet,  numbers,  and  special  characters.  In  dBASE  III  PLUS,  the 
character  type  is  made  up  of  the  set  of  all  ASCII  characters.  A 
character  string,  often  just  called  a  string,  is  any  sequence  of 
ASCII  symbols.  When  a  number  is  represented  as  a  character  type, 
it  must  first  be  converted  to  numeric  data  before  calculations  can 
be  performed  with  it.  It  is  often  convenient  to  use  the  character 
data  type  for  numbers  such  as  telephone  numbers,  addresses,  and 
inventory  stock  numbers  which  will  not  be  used  In  calculations. 
Some  of  the  more  common  operations  performed  on  strings  are: 
Concatenating  strings  (linking  them  together) 

Splitting  up  strings  into  "substrings" 

Testing  strings  for  equality 
Finding  substrings  (string  patterns) 

The  character  variable  contains  textlike  information:  "David 
Smith","1234  Fifth  Street", "Computer  Science  Department".  Any 
information  between  the  quote  signs  will  be  taken  as  a  character 
string.  The  maximum  length  or  a  string  is  254  characters.  The 
minimum  length  of  a  string  is  0. 

Because  dBASE  III  PLUS  is  a  business  oriented  language,  it 
deals  much  more  in  text  manipulation  than  computer  languages 
such  as  BASIC  and  Pascal. 
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A  field  defined  as  a  numeric  field  will  only  accept  the 
digits  0  through  9,  the  decimal  point,  and  the  negative  sign(-)  as 
data.  (Trying  to  force  character  data  into  a  numeric  field  will  lock 
up  the  keyboard.)  Numeric  data  is  used  to  represent  integers  or 
decimal  quantities  that  will  undergo  computations.  dBASE  III  PIUS 
allows  a  wide  range  of  numbers  and  has  adequate  precision  for 
most  business  and  scientific  applications.  It  maintains  an  internal 
precision  of  fifteen  or  sixteen  digits,  depending  on  the  size  of  the 
number.  This  allows  dBASE  III  PLUS  to  be  accurate  on  calculations 
with  fairly  large  numbers  without  round  off  error.  Internally 
dBASE  III  PLUS  represents  numbers  with  the  IEEE  long  real  (64-bit) 
binary  floating  point  representation.  A  binary  floating  point 
representation  is  the  computer's  equivalent  to  scientific  notation. 
Each  number  contains  three  parts:  the  sign,  either  +  or  -,  the 
slgniflcand  which  represents  the  significant  digits  of  the  number, 
and  the  exponent  which  multiplies  the  significand  by  the 
appropriate  power  to  yield  the  correct  binary  point  position  in  the 
final  result. 


A  logical  data  field  is  one  which  is  of  a  predefined  length,  1 
character,  and  will  accept  as  input  either  the  letters  T  or  7  (for 
TRUE/YES)  or  the  letters  F  or  N  (for  r  ALSE/NO.) . The  actual  lata  .o 
stored  exactly  as  entered,  but  will  be  displayed  on  the  screen  or 
printer  as  .T.  or  ,F.  only.  If  no  data  is  entered,  the  default  is  .F. 

Logical  data  fields  are  used  to  represent  types  of  data  when 
there  are  only  two  choices  for  any  element,  such  as  maie/remaie. 
positive/negative,  yes/no,  dead/alive.  dBASE  III  PLUS  can  perform 
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conditional  tests  which  depend  on  the  value  of  a  logical  field. 

4.  Date  Data  Type 

A  date  data  field  is  also  of  a  predefined  length,  eight 
characters,  and  dBASE  III  PLUS  presumes  that  you  will  be 
subsequently  entering  a  date  of  the  format  MM/DD/YY.  At  the  time 
of  actual  data  entry  into  this  field,  dBASE  111  PLUS  automatically 
checks  for  the  accuracy  of  the  data  entered.  For  example,  an 
entry  of  12/35/85  would  invoke  a  beep  and  an  error  message.  The 
built-in  edit  even  checks  for  a  leap-year!  Date  fields  are  very 
useful  in  that  they  reduce  the  amount  of  programming  effort 
needed  for  routines  computing  time  lapse,  since  you  can  add 
numbers  to  or  subtract  numbers  from,  date  fields,  or  you  can  add 
or  subtract  two  date  fields  directly. 

5.  Memo  Data  Type 

A  memo  data  field  is  also  of  a  predefined  length,  10 
characters  in  the  file  itself,  and  automatically  contains  the  word 
memo  for  data.  Through  the  use  of  this  field,  you  can  maintain 
memos  for  individual  records  Each  memo  could  be  up  to  4000 
cnaracters  long  if  the  built-in  dBASE  III  PLUS  word  processor  is 
used,  or  can  be  any  length  If  It  is  set  up  with  a  commercial  word 
processor.  dBASE  III  PLUS  makes  use  of  an  external  file  in  which  it 
stores  the  contents  of  the  individual  memos,  and  hence  the  memo 
can  have  the  capacities  mentioned  above,  'his  external  file  will 
have  the  same  primary  name  as  the  dBASE  III  PLUS  file,  but  will 
have  the  .DBT  extension  for  the  secondary  name.  dBASE  III  PLUS 
maintains  this  file  in  an  internally  usable  form 

D.  DATA  STRUCTURES  OF  dBASE  III  PLUS 


30 


dBASE  III  PLUS  contains  powerful  high  level  commands  which 
allow  people  to  create  and  manipulate  sophisticated  data  structures 
easily.  There  are  several  common  models  used  to  represent  data 
structures.  dBASE  III  PLUS  uses  the  relational  model:  the  data  is 
represented  in  flat  (two-dimensional)  tables  composed  of  rows  and 
columns.  In  relational  databases,  a  two-dimensional  table  is  known 
as  a  "relation",  and  operations  on  these  tables  can  be  described 
with  mathematical  precision.  However,  the  relational  model  is 
very  powerful  and  all  other  common  data  models  can  be 
represented  using  two-dimensional  (relational)  tables. 

The  CREATE  command  is  used  to  create  a  data  file  structure 
matching  the  body  of  data  that  it  is  intended  to  represent  This 
structure  can  store  data  as  individual  records  and  the  data  can 
then  be  easily  accessed  and  manipulated. 

1.  The  Data  File  Structure 

The  dBASE  111  PLUS  data  file  can  be  seen  as  a 
two-dimensional  table  containing  the  following  properties: 

a.  All  items  in  a  column  are  of  the  same  data  type;  that 
is,  the  data  file  is  column- homogenous.  A  column  in 

dBASE  ill  PLUS  is  a  field. 

b. Each  column  (or  field)  must  have  a  distinct  fieldname.  No 
duplicate  fieldnames  are  allowed. 

c. Each  row  is  a  record  and  is  assigned  a  number  The 
record  numoer  assigned  is  relative  to  the  record's  position  in  the 
data  file. 

A  conceptual  view  of  a  dBASE  III  PLUS  data  file  is 


RECORD 

RECORD 


FIELD  1  FIELD  2 


Figure  5-i 


The  limitations  on  dBASE  III  PLUS  data  files  are: 

File  limits  (maximum  sizes) 

Number  of  records/file  1  billion 

Record  size  (bytes)  4000  bytes  in  DBF  file 

Number  of  fields/record  128 

Field  limits 


Character  fields 
Logical  fields 
Numerical  fields 
Date  fields 
Memo  fields 
DBF  file  size  limit  only 
or  word  processor  used. 


254  bytes 
1  byte 
19  bytes 
8  bytes 

10  bytes  in  DBF  file 
by  operating  system,  hardware 


2.  Indexing 

One  of  the  most  important  features  of  any  database  system 
is  the  ability  to  find  a  specific  data  item  from  among  many  item 
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quickly.  Search  by  index  is  the  best  way  to  shorten  long  sequential 
search  times  to  only  a  couple  of  seconds. 

When  the  INDEX  ON  <key>  command  is  issued  in  dBASE  III 
PLUS,  a  seperate  index  file  is  creates  based  on  the  key  expression 
specified  in  the  command  line.  The  followings  are  examples  of 
creating  indexed  files: 

.  USE  Customer  (Select  data  file) 

.  INDEX  ON  Names  TO  Customer  (Generate  index) 

This  index  allows  rapid  searches  of  the  Customer  database  by 
Name  .  Any  record  can  be  found  in  two  seconds  or  less  with  the 
FIND  or  SEEK  command. 

E.  PROGRAMMING  IN  dBASE  III  PLUS 

In  dBASE  III  PLUS,  a  program  is  actually  a  set  of  commands  :n 
sequence.  To  create  a  program,  at  dot-prompt,  Just  type  in: 

.CREATE  COMMAND  pgm  <CR> 

This  command  Informs  dBASE  III  PLUS  of  your  intention  to  create 
a  command  file  (program)  called  pgm.PRG.  The  screen  is  then 
erased;  the  dBASE  III  PLUS  word  processor  takes  over;  there  is  no 
dot-prompt;  and  whatever  you  key  in  will  remain  on  the  screen, 
until  you  either  SAVE  lt(Ctri-W),  or  DELETE  itfCtri-Qj. 

To  Invoke  the  execution  of  a  program,  simply  request  dBASE  III 
PLUS  to: 

DO  PGM  <CR> 

To  make  changes  to  on  existing  program,  use  the  renewing 
command 

.MODIFY  COMM  pgm  <CR> 

1  Par-imevr  Passing 

The  main  value  of  parameter  passing  occurs  when  a  low 
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command  flic  can  be  called  from  many  different  programs  in 
many  situations  and  must  be  free  of  the  naming  convention  used 
In  the  calling  program. 

There  are  two  Kinds  of  variables,  PUBLIC(global)  and 
PRIVATE(local).  A  PUBLIC  variable  can  only  be  released  by  the 
programmer  while  a  PRIVATE  variable  is  released  by  dBASE  III 
PLUS  when  the  program  returns  from  the  command  file  in  which 
the  variable  was  created. 

All  variables  created  in  a  command  file  are  PRIVATE  unless 
specifically  declared  PUBLIC.  All  variables  created  in  higher  level 
command  file  are  available  to  the  lower  level  command  files  unless 
there  is  a  clash.  If  a  variable  is  declared  PRIVATE  in  a  command 
file  and  there  exists  another  variable  from  a  higher  level  with  the 
same  name,  then  dBASE  III  PLUS  has  to  decide  which  variable  is  to 
be  referenced  and  which  is  to  be  hidden.  Until  the  PRIVATE 
variable  is  released,  dBASE  III  PLUS  hides  the  higher  level  variable 
and  all  references  of  the  variable  name  refer  to  the  lower  level 
variable. 

The  variable  status,  PUBLIC  or  PRIVATE,  can  be  directly 
specified: 

PUBLIC  name,  city 

PRIVATE  salary 

Any  variable  can  be  released  with  the  RELEASE  command: 

RELEASE  name,  city 

dBASE  III  PLUS  automatically  releases  a  PRIVATE  variable  when 
the  user  leaves  a  command  file  with  RETURN,  CANCEL,  or  QUIT. 
Usually  variables  are  passed  from  one  command  file  to  another 
without  specific  instructions.  With  parameter  passing,  the  high 
level  command  file  does  not  have  to  follow  the  same  naming 
convention  that  the  low  level  command  file  uses. 
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PUBLIC  variables  should  be  used  sparingly.  Generally 
variables  should  not  be  made  PUBLIC  without  some  specific  reason. 
While  debugging,  the  most  important  variables  should  be  PUBLIC  so 
that  they  can  be  inspected  if  the  program  crashes  and  control 
returns  to  the  dot  prompt  (thereby  releasing  all  the  private 
variables) . 

2.  Control  Tranfers  From  One  Program  To  Another 

Just  as  you  invoke  the  execution  of  a  program  by  asking 
dBASE  III  PLUS  to  DO  <program  name>,  you  can  invoke  the 
execution  of  another  program  from  within  the  first  one  in  the 
same  way.  The  calling  program,  at  some  logical  point  in  its 
execution,  transfers  control  to  the  called  program.  At  the  end  of 
the  execution  of  the  called  program,  control  is  automatically 
transferred  to  the  instruction  after  the  DO  instruction  that 
passedcontrol  to  the  called  program. 

This  concept  of  transferring  control  to  subprograms  and  then 
receiving  control  back  at  the  main  program  is  very  important  to 
the  programmer,  since  it  permits  the  breakdown  of  a  large 
complicated  system  into  subset  of  logically  connected,  more 
manageable  subprograms.  This  makes  the  system  much  more 
comprehensible  not  only  to  other  programmers  but  also  to  the 
creator  of  the  system. 

F.  HOW  DOES  dBASE  III  PLUS  IMPLEMENT  THE  RELATIONAL  MODEL 
In  dBASE  III  PLUS,  there  is  a  very  powerful  command: 

SET  RELATION  TO 


The  SET  RELATION  creates  a  link  between  two  data  files.  Its 
power  stems  from  the  fact  that  dBASE  III  PLUS  will  automatically 
look  up  related  information  from  another  file.  This  means  that 


FORM  commands,  will  perform  a  search  of  another  database. 

As  an  example,  suppose  sales  information  is  kept  in  one  file  and 
time  of  shipment  information  in  a  second  file.  SET  RELATION  will 
allow  the  user  to  produce  reports  on  the  transactions  in  which 
dBASE  III  PLUS  looks  up  the  sales  information  at  each  transaction. 
For  example,  in  SLINQUERY .  PRG : 

SELECT  1 

USE  b:sL.contra  INDEX  b:s^conind 

SELECT  2 

USE  b:  tmofship  INDEX  b.tmshipdx 
then  in  SALELIST.PRG: 

SET  RELATION  TO  snumber  INTO  tmofship 
this  will  create  relationship  between  SL-Contra  and  tmofship  with 
snumber  as  the  common  key. 

SET  RELATION  is  equivalent  to  a  user  who  always  performs  a 
SEEK  command  at  each  record  but  it  is  faster  than  writing  the 
individual  commands  and  it  enables  many  dBASE  III  PLUS 
command  to  utilize  the  second  file.  This  gives  multi-file  capabilities 
to  the  nonprogrammer. 

G.  I/O  PROCESSING  OF  dBASE  III  PLUS 

The  I/O  processing  of  dBASE  111  PLUS  is  more  concerning  about 
the  communication  between  the  programmer  and  operator.  This 
communication  can  be  broken  down  into  two  categories: 

1.  Output:  The  programmer  talks  to  the  operator. 

2.  Input: The  operator  talkks  to  the  programmer. 

As  mentioned  above,  dBASE  III  PLUS  was  designed  for 
microcomputers.  Most  current  I/O  devices  used  on  microcomputers 
are  CRTs(or  screen).  Therefore,  dBASE  III  PLUS  contains  very 
powerful  screen  handling  capabilities  discussed  below. 
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powerful  screen  handling  capabilities  discussed  below. 


1.  Output 

In  dBASE  III  PLUS,  output  screen  handling  refers  to  the 
process  by  which  the  programmer  talks  to  the  operator.  The 
output  commands  used  to  support  screen  handling  can  be 
categorized  according  to  the  mode  in  which  they  work: 

a.  FORMATTED  MODE 
e  <coordinate>  SAY 

This  command  places  its  output  at  the  screen  location  specified  by 
the  programmer,  thus  formatting  the  screen. 

In  addition,  it  has  options  which  allow  the  programmer  to 
modify  the  display  of  its  data,  thus  formatting  its  output. 

b.  UNFORMATTED  MODE 
General: 

? 

?? 

Specialized: 

DIR 

DIRECTORY 

DISPLAY 

LABEL 

TYPE 

These  commands  are  dependent  upon  the  current  cursor 
position  and  begin  their  output  at  that  location.  The  most 
frequently  used  commands  in  communicating  with  the  operator  in 
dBASE  III  PLUS  programming  applications  is  the  SAY  command 
because  of  the  degree  of  control  it  offers.  The  ?  command  is 
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when  a  screen  scrolling  effect  is  desired. 

TEXT  . . .  ENDTEXT  Is  a  structured  output  command, 
rather  than  a  structured  programming  command  because  It  has  no 
effect  at  all  on  program  flow.  It  is  simply  a  convenient  way  of 
outputting  large  amounts  of  unformatted  text.  The  literal  text 
must  be  contained  within  the  TEXT  ...  ENDTEXT  structure,  and 
therefore  is  a  constant  in  the  command  file. 

c.  FORMATTED  SCREEN 

The  <coordinates>  specified  in  the  P  ...  SAY  command 
control  where  the  output  will  appear  on  the  screen.  The  syntax 
and  range  for  computers  with  24X80  screens  is: 

9  <coordinates>  SAY  <expression> 

<coordinates>  =  <row>,  <column> 

<row>  =  numeric  expression,  range  0-23  (line) 

<column>  =  numeric  expression,  range  0-79 
Note  that  minus  numbers  cannot  be  used  with  this  relative 
addressing  operator. 

d.  FORMATTED  OUTPUT 

In  addition  to  formatting  the  screen,  we  can  also  format 
the  individual  picture  of  each  data  item  when  we  display  it.  The 
•...SAY  command  offers  the  programmers  a  variety  of  options  for 
displaying  data  In  a  format  different  than  the  format  In  which  it 
exists.  For  example,  a  numeric  field  cannot  contain  commas,  but 
it  can  be  displayed  with  commas  when  output  with  @...SAY 
command.  The  syntax  and  formatting  options  are: 

•  <coordinates>  SAY  <expression>  <format  option> 
<format  optlon>  =  PICTURE  ‘<picture  templates 
|  FUNCTION  *{<function>}' 
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I  FUNCTION  '{<function>}' 

I  USING  '{<using  symbol>}' 

2.  Input 

Input  screen  handling  refers  to  the  process  by  which  the 
operator  talks  to  the  programmer.  Output  screen  handling  is  the 
reverse  of  this.  Operator  input  must  be  carefully  handled.  This  is 
the  time  to  trap  all  the  possible  errors  so  that  the  data  in  the 
database  is  always  known  to  be  accurate  and  good.  The  input 
commands  used  in  dBASE  III  PLUS  can  be  categorized  according  to 
the  mode  in  which  they  work. 

a.  FULL-SCREEN  MODE 
@. .  .GET 

This  command  places  a  variable  (field  or  memory  variable)  at  the 
screen  location  specified  by  the  programmer.  In  addition,  it  has 
options  which  allow  the  programmer  to  restrict  the  operator's 
input. 

READ  [NOUPDATE] 

This  command  places  the  cursor  in  variables  which  have  been 
placed  on  the  screen  with  @.  ..GET.  This  enables  the  operators  to 
enter  or  edit  data  in  the  varaible. 

b.  COMMAND-LINE  MODE 
Memvar: 

ACCEPT  ^character  type; 

INPUT  (date,  logical,  and  numeric  types) 

WAIT  (character  type,  one  character  only) 

Of  course,  the  most  frequently  used  commands  for  receiving 
communications  from  the  operator  is  the  @...  GET/READ 


often  used  to  simply  pause  the  program  execution  until  the 
operator  hits  any  key;  the  keystroke  itself  is  usuall  disregarded. 

ACCEPT  and  INPUT  are  usually  used  for  quick  utility  type 
applications  where  a  high  degree  of  error  trapping  is  not  required, 
or  when  it  is  desirable  to  give  the  operator  lots  of  flexibility,  such 
as  in  programmer's  utilities.  ACCEPT  will  only  accept  a  character 
type  literal  while  INPUT  will  accept  an  expression  of  any  data  type. 

Screen  placement  and  appearance  of  @...GET  are  the  same  as 
for  #. .  .SAY,  which  are  mentioned  above.  There  is  one  combination 
form,  the  #..  .SAY. .  .GET  which  places  the  GET  <varlable>  on  the 
screen  immediately  following  the  SAY  <prompt>. 

#  5,  0  SAY  'Your  name:' 

#  5,14  GET  memvar 

#5,0  SAY  'Your  name: '  GET  memvar 
These  both  produce  the  same  results.  The  first  form  makes  writing 
some  screen  easier.  The  second  form  runs  faster. 

c.  FORMATTED  INPUT 

The  #. .  .GET  command  offers  the  programmer  a  variety  of 
options  for  limiting  the  data  that  the  operator  can  enter.  For 
example,  a  character  type  variable  can  be  limited  to  accepting 
only  numbers  from  the  keyboard.  The  syntax  and  formatting 
options  are: 

#  <coordinates>  GET  <variable  name>  <format  option> 
<variable  name>  =  A  currently  active  memvar 
|  A  field  in  the  currently  selected 
database  file 

<format  option>*=  PICTURE  ’<picture  template^ 

|  FUNCTION  '{<function>}' 
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d.  FORMAT  FILE 

Format  flies  are  like  command  flies  except  that  they 
contain  only  $. . .SAY  and  . .GET  commands  and  comments. 
Format  files  allow  the  formatting  of  the  screen  during  the 
full-screen  interactive  database  commands  APPEND,  CHANGE,  EDIT, 
and  INSERT.  An  open  format  file  also  affects  the  execution  of  the 
READ  command  by  clearing  the  entire  screen,  resetting  the  GET 
counter,  and  redisplaying  its  SAYs  and  GETs.  DBASE  III  PLUS  can 
have  one  format  file  for  each  of  its  ten  work  areas  if  this  will  not 
exceed  the  limit  of  thirteen  simultaneously  open  files  of  all  kinds.  It 
also  closes  any  open  format  file  in  the  currently  selected  work  area 
when  a  new  database  file  is  opened  or  any  current  one  closed. 

This  command  open  a  format  file: 

SET  FORMAT  TO  <format  filename> 

These  commands  close  all  open  format  file: 

CLEAR  ALL 
CLOSE  DATABASES 

These  commands  close  only  the  open  format  file  in  the  currently 
selected  work  area: 

CLOSE  FORMAT 
SET  FORMAT  TO 
USE 


H.  SUMMARY 

In  dBASE  III  PLUS,  there  are  no  ARRAYS,  RECORDS,  SETs, 
FUNCTIONS,  ENUMERATED  TYPES  nor  LINKED  LISTs.  These  were 
considered  to  be  necessary  for  structured  programming,  but  quite 
an  overhead  to  a  database  system.  dBASE  III  PLUS  uses  nothing 


but  two-dimensional  tables  to  implement  its  data  structures  and 
file  organizations.  dBASE  III  PLUS  consists  of  a  set  of  commands 
each  with  a  "syntax."  Each  command  is  extremely  flexible  and  can 
perform  an  infinite  number  of  variations  on  a  particular  task.  It's 
invaluable  flexibility  requires  more  learning  effort  on  the  part  of 
the  user. 

The  control  structures  such  as  SEQUENCE,  BRANCH,  REPETITION 
and  those  algorithms  which  are  used  in  most  programming 
languages  are  available  in  dBASE  III  PLUS  too.  But  dBASE  III  PLUS 
does  not  support  recursion. 

In  general,  dBASE  III  PLUS  is  a  versatile  database  manager.  It  Is 
designed  to  handle  the  many  business  applications  in  which  the 
user  needs  to  manage  large  amounts  of  repetitive  information.  It 
can  function  as  a  simple  file  manager.  It  can  handle  the  complex 
issues  in  relating  files  to  one  another,  and  it  can  be  used  as  a 
complete  language  like  Pascal  or  BASIC. 


A.  BACKGROUND 

The  original  program  -  written  in  Pascal,  is  a  typical  inventory 
management  system  software,  written  for  Import/Export 
Company,  which  purchases  feed  stuffs  such  as  hays,  grass,  etc., 
from  farmers  in  California.  Those  feed  stuffs  are  compressed  and 
packed  into  9X40  foot  containers  and  shipped  to  foreign 
countries.  This  program  was  written  in  order  to  keep  track  of  the 
sales  and  the  purchase.  For  instance,  how  many  tons  of  the 
grass  have  been  purchased?  How  many  of  them  have  been 
shipped?  At  what  price,  and  what  time?  How  many  tons  left  need 
to  be  shipped  to  complete  a  contract?  The  analysis  of  the  algorithm 
and  data  structures  used  in  this  program  are  discussed  in  detail  in 
the  following  sections. 

B.  THE  ENTITY-RELATIONAL  DIAGRAM 

Sales  and  Purchases  are  an  independent  process  within  Hanaoka, 
as  can  be  seen  on  the  next  page  (Figure  4-1).  The  E-R  diagram  of 
Hanaoka  was  divided  into  two  sub-diagrams.  The  upper  part  is  for 
Purchases  and  the  lower  part  is  for  Sales.  There  are  some  identical 
components  in  these  two  sub- diagrams. 

In  Sales,  each  sale  record  contains  one  customer  and  several 
time-of-shippings  records.  The  sale  record  is  used  to  update  the 
sale  contract  according  to  the  contract  number.  The  sale  contract 
uses  the  Invoice  number  (input  from  screen)  concatenated  with 
the  contract  number  as  a  new  invoice  number  to  update  the  sales 
shipment  record.  Data  Is  passed  from  the  sales  record.  Also  the 
sales  record  can  be  used  to  check  the  hash  file  for  the  duplicate 


key.  If  there  is  no  duplicate  key  then  this  sales  record  can  be 
inserted  into  an  empty  slot  of  the  hash  file  according  to  the  status 
(empty  or  occupied)  of  that  slot.  Each  sales  shipment  can  be 
updated  by  the  sales  shipment  record  and  each  sales  shipment 
contains  several  containers 

In  Purchase,  each  purchase  record  corresponds  to  each  farmer. 
Each  purchase  record  can  contain  several  tlme-of-shipping  records. 
New  purchase  information  can  be  stored  into  the  hash  file  and 
purchase  file  by  checking  the  slot’s  status  (empty  or  occupied).  One 
purchase  needs  one  purchase  shipment  record  which  can  contain 
several  trucks  records,  and  can  be  used  to  update  purchase 
shipment  records. 

C.  PROGRAM  STRUCTURES 

1.  Sales 


Figure  4-2  Structured  diagram  of  Sales 


The  followings  is  the  program's  outline  for  Sales. 
(  For  details,  please  reference  APPENDIX  A  ) 


45 


* 


MAIN  PROGRAM 


SEGMENT  PROCEDURE  fssinquery; 

{  to  prompt  the  query  concerning  the  feed  stuff  sales  files  } 

BEGIN 

END; 

SEGMENT  PROCEDURE  fssnew; 

{  to  input  new  sales  contract  into  the  files  } 

BEGIN 

END; 


SEGMENT  PROCEDURE  fssshipment; 

{  to  input  shipment  information  for  the  existing  contract  } 

BEGIN 

END; 

PROCEDURE  fdstfsales; 

{  procedure  to  handle  all  operations  concerning  feed  stuff  sales  } 

BEGIN 

END; 


•nontax* 


Montaa* 


FSSNEW  * 

sx**ant**ss*xx***axsxxa*aa*xxxxxuxxxxx*xxxxs*xxxxx«** 


SEGMENT  PROCEDURE  fssnew; 

PROCEDURE  tosconvert; 

{  converts  timeofship  array  input} 

BEGIN 

END; 

PROCEDURE  getfssinfo; 

{  input  all  pertinent  info  for  new  sales  contract  } 

FUNCTION  proceed  :  boolean; 

{  returns  true  if  the  input  line  is  not  empty,  so  not  to  allow 
null  input  } 

BEGIN 

END; 

PROCEDURE  tosinfo; 

{  handles  one  input  array  timeofship,  different  proc  since  the 
input  format  differs  from  other  input, i,e.,  makes  procedure 
READNEXTINPUT  too  long  } 

BEGIN 
END; 


Figure  4-3  structure  diagram  of  FSSNEW 
PROCEDURE  readnextlnput; 

{  handle  one  input  at  a  time,  var  lineno  determines  which 
input  } 

BEGIN 

END; 

PROCEDURE  fssmodlfy; 

{  re-reads  any  specified  input  once  more  } 

BEGIN 

END; 

BEGIN 

END; 

BEGIN 

END. 

tntniinutnmmnmmMnntnnMMinununtmmmtnMmu 

*  FSSSHIPMENT  * 

xaxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 


SEGMENT  PROCEDURE  fssshipment; 

PROCEDURE  contconvert; 

{  converts  container  array  Input  from  string  to  approriate  data 
type  } 

BEGIN 

END; 

PROCEDURE  computepart; 

{^does  all  necessary  conversion  (lbs->shorttons)  and  computation 

BEGIN 

END; 

PROCEDURE  getshipinfo; 

{  get  all  pertinent  info  for  a  shipment} 

FUNCTION  sproceed  :  boolean; 

{  same  as  FUNC  proceed  } 

BEGIN 

END; 


bshipinv 


signature 


Figure  4-4  Structure  diagram  of  FSSSHIPMENT 
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PROCEDURE  nextshiplnput; 

{  reads  one  input  at  a  time  } 

BEGIN 

END; 

PROCEDURE  shipmodify; 

{  re  reads  specified  input  once  more  } 

BEGIN 

END; 

BEGIN 

END; 

PROCEDURE  shippaperwork, 

{  produces  five  documents  pertaining  one  shipment  } 

PROCEDURE  signature; 

{  write  closing  (like  rubber  stamp)  } 

BEGIN 

END; 

PROCEDURE  underline; 

{  prints  for  specified  no  of  times  } 

BEGIN 

END; 

PROCEDURE  ashlpinv; 

{  top  half  of  Invoice  } 

BEGIN 

END; 

PROCEDURE  bshipinv; 

{  bottom  half  of  Invoice  } 

BEGIN 

END; 

PROCEDURE  ashlppaklist; 

{  top  half  of  packing  list  } 

BEGIN 

END; 

PROCEDURE  bshippaklist; 

{  bottom  half  of  packing  list  } 

BEGIN 

END; 


PROCEDURE  acertorigin; 

{  top  half  of  cert  of  origin  } 

BEGIN 

END; 


PROCEDURE  bcertorigin; 
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{  bottom  half  of  cert  of  origin  } 

BEGIN 

END; 

PROCEDURE  aphytocert; 

{  top  half  of  phytosanitary  cert  } 

BEGIN 

END; 

PROCEDURE  bphytocert; 

{  bottom  half  of  phytosanitary  cert  } 

BEGIN 

END; 

PROCEDURE  fumigation; 

{  fumigation  certificate  } 

BEGIN 

END; 

BEGIN  {  shlppaperwork  } 

END; 

BEGIN 

END. 


FSSINQUERY 


Figure  4-5  Structure  diagram  of  FSSINQUERY 


SEGMENT  PROCEDURE  fssinquery; 

{  handles  queries  of  following  types: 
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1.  list  all  customers  by  company  name. 

2.  list  all  contracts  of  one  customer. 


3.  list  all  Information  (Include  all  shipments  made)  of  one 
contract 

4.  list  available  spaces  in  FSSF1LE  and  FSSSHIPF1LE  } 
PROCEDURE  Usttop; 

{  list  top  half  of  contract  information  } 

BEGIN 

END; 

PROCEDURE  llstbottom; 

{  list  bottom  half  of  contract  information  } 

BEGIN 

END; 


PROCEDURE  prllsttop; 

{  same  as  listtop  but  outputs  to  printer  } 

BEGIN 

END; 

PROCEDURE  prlistbottom; 

BEGIN 

END; 

PROCEDURE  listship; 

{  list  shipment  info  to  console  } 

BEGIN 

END; 

PROCEDURE  prllstship; 

{  list  shipment  info  to  printer  } 

BEGIN 

END; 

PROCEDURE  onecontrlnfo; 

{  handles  query  of  type  3  } 

PROCEDURE  case3$ub; 

{  handles  the  shipment  info  of  one  contract  and  printout  of 
contract  info  to  the  printer  } 

BEGIN 

END; 

BEGIN 

END; 
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PROCEDURE  residuecheck; 

{  handles  query  of  type  4  } 

BEGIN 

END; 

BEGIN  {  FSSINQUERY  } 

END;  {  Note  query  1  &  2  Is  handled  in  this  main  procedure  } 


2.  Purchase 


Figure  4-6  Structure  diagram  of  Purchase 


Followings  are  the  program's  outline  of  purchase: 

(For  details,  please  reference  APPENDIX  A) 
========================  PURCHASE  ====================== 

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

*  MAIN  PROGRAM  * 

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

SEGMENT  PROCEDURE  fspmquery; 

{  to  prompt  the  query  concerning  the  feed  stuff  purchase  file  } 

BEGIN 

END; 

SEGMENT  PROCEDURE  fspnew; 

{to  input  new  purchase  contract  into  the  files  } 

BEGIN 

END; 


SEGMENT  PROCEDURE  fspshipment; 

{  to  input  shipment  information  for  the  existing  contract  } 

BEGIN 

END; 

PROCEDURE  fdstfpurchase; 

{  procedure  to  handle  all  operations  concerning  feed  stuff  purchase 

} 

BEGIN 

END; 

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

*  FSPNEW  * 

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 


Figure  4-7  Structure  diagram  of  FSPNEW 


SEGMENT  PROCEDURE  fspnew; 

PROCEDURE  tosconvert, 

{  converts  timeofship  array  input  } 


BEGIN 

END; 


PROCEDURE  getfspinfo; 

{  input  all  pertinent  info  for  new  purchase  contract  } 

FUNCTION  pproceed  :  boolean; 

{  return  true  if  the  input  line  is  not  empty,  so  not  to  allow 
null  input  } 

BEGIN 

END; 

PROCEDURE  tosinfo; 

{  handles  one  input  array  timeofship,  different  proc  since  the 
input  format  differs  from  other  input,  i,e.,  makes  procedure 
readnextinput  too  long  } 

BEGIN 

END; 

PROCEDURE  nextpurinput; 

{  handles  one  input  at  a  time,  var  lineno  determines  which 
input  } 

BEGIN 

END; 

PROCEDURE  fspmodify; 

{  re  reads  any  specified  input  once  more  } 

BEGIN 

END; 

BEGIN 

END; 

BEGIN 

END; 

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 

*  FSPSHIPMENT 

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

SEGMENT  PROCEDURE  fspshipment; 

PROCEDURE  truckconvert; 

{  converts  truck  array  input  from  string  to  approriate  data  type 

} 

BEGIN 

END; 


PROCEDURE  gettruckrate; 

{  decides  the  price  rate  and  convert  into  approriate  data  type  } 

BEGIN 

END; 


Figure  4-8  Structure  diagram  of  FSPSHIPMENT 
PROCEDURE  truckcostcomp; 

{  decide  the  rate  base  (lbs  or  short  tons)  and  does  the 
computation  } 

BEGIN 

END; 

PROCEDURE  fspeompute; 

{  compute  the  numeric  data  according  the  rates  and  bases  } 

BEGIN 

END; 

PROCEDURE  getpurshipinfo; 

{  get  all  pertinent  info  for  a  shipment  } 

FUNCTION  psproceed: 

{  same  as  pproceed  } 

BEGIN 


END; 

PROCEDURE  nextpurshipinput, 

{  reads  one  input  at  a  time  } 

BEGIN 

END; 

PROCEDURE  purshlpmodify; 

{  re  reads  specified  input  once  more  } 

BEGIN 

END; 

BEGIN 

END; 


XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 

*  FSPINQUERY  * 

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

SEGMENT  PROCEDURE  listpurcontr; 

{  list  purchase  contract  to  the  console  } 

BEGIN 

END; 

SEGMENT  PROCEDURE  prlistpurcontr; 

{  list  purchase  contract  to  the  printer  } 

BEGIN 

END; 

SEGMENT  PROCEDURE  purcontrlnfo; 

{  list  purchase  shipment  information  } 

PROCEDURE  listpurship; 

{  list  purchase  shipment  information  to  the  console  } 

BEGIN 

END; 

PROCEDURE  printpurship; 

{  list  purchase  shipment  information  to  the  printer  } 

BEGIN 

END; 

PROCEDURE  subpurcontr; 

{  list  shipment  informations  in  sequence  } 

BEGIN 

END; 

BEGIN 

END; 
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fspinquery 


printpurthip 


liatpurship 


Figure  4-9  Structure  diagram  of  FSPINQUERY 


SEGMENT  PROCEDURE  fspresiduecheck; 

{  handles  query  of  type  4  } 

BEGIN 

END; 

SEGMENT  PROCEDURE  fspinquery; 

{  handles  queries  of  following  types: 

1.  list  all  commodities. 

2.  list  all  contracts  of  one  commodities. 

3.  list  all  information  (include  all  shipments  made)  of  one 
contract 

4.  list  available  spaces  in  fspfile  and  fspshipflle  } 

BEGIN 

END; 


In  order  to  use  the  dBASE  III  PLUS  to  rewrite  the  original 
program,  we  need  to  replace  the  existing  set  of  files  by  its  logical 
equivalent.  The  term  "  file  structure,  "  refers  to  the  complete  set 
of  stored  data,  its  division  into  component  sets,  and  the 
relationships  that  exist  among  those  components.  In  most  cases, 
the  component  sets  are  files  or  repeating  groups  within  files.  The 
relationships  that  exist  among  components  include  access  keys, 
ordering  techniques,  redundancies,  pointers,  and  so  forth. 

It  is  the  whole  file  structure  that  must  be  logicalized.  To  talk 
about  deriving  logical  equivalents  of  each  current  file  is  fruitless, 
because  the  very  decision  that  some  of  these  files  should  exist  at  all 
may  have  been  physical.  So  we  have  to  go  back  and  think  about 
the  whole  (the  union  of  all  data  elements),  and  start  from  scratch 
to  divide  those  files  into  its  component  pieces. 

The  process  of  dividing  those  files  into  its  components  is  called 
normalization,  which  is  a  process  to  analyze  the  functional  and 
multivalued  data  dependencies.  The  objective  of  normalization  is  to 
avoid  redundancy  and  update,  insert,  and  deletion  anomalies. 
Each  time  we  normalize  a  file,  we  replace  a  multipurpose  file  by 
two  or  more  files.  These  files  together  can  accomplish  the  same  set 
of  purposes  as  the  original.  The  new  files  are  always  more 
singleminded  than  the  one  they  replace.  It  frequently  happens  that 
the  new  equivalent  files  need  to  be  normalized  again. 

There  are  different  levels  of  normalization,  named  1st  normal 
form,  2nd  normal  form,  3rd  normal  form,  BC  normal  form. 
4th  normal  form,  5  th  normal  form  and  domain/key  normal 
form 


A  relation  is  in  INF  (1st  normal  form)  if  it  contains  no  repeating 
groups.  It  is  a  simple  matter  to  produce  INF  from  an  unnormalized 
relation. 

A  relation  is  in  2NF  if  it  is  in  INF  and  there  are  no  partial 
dependencies. 

A  relation  is  in  3NF  if  it  is  in  2NF  and  there  are  no  transitive 
dependencies.  For  most  practical  databases,  3NF  is  sufficient. 

A  relation  is  in  BCNF  (Boyce  Codd)  if  it  is  in  3NF  and  every 
determinent  is  a  candidate  Key. 

A  relation  is  in  4NF  if  it  is  in  BCNF  and  there  are  no  multivalued 
dependencies. 

Before  rewriting  the  original  program,  we  have  to  normalize  the 
relations  of  the  files  used  In  the  original  program,  then  use  those 
normalized  logical  file  structures  to  create  new  Entity-Relational 
diagrams  and  a  new  relational  database  written  with  dBASE  III 
PLUS. 

A.  NORMALIZATION  OF  SALES 

As  we  can  see  in  Appendix  A,  the  file  structures  declared  in  the 
original  program  are  listed  as  follows: 

FSSFILE  {  Status,  Number,  ContrDate,  Customer.  Name, 
Customer. Addr,  Customer. ContrNo,  Commodity,  Pricebase, 
Lc.  Number,  Lc.ExpDate,  Lc.ShipDate,  Lc.Bal,  Lc.  Amount, 
TlmeOfShip.  TotalShip,  BalOfShip,  IssueBanK,  DrawBanK, 
MltiNo,  NofShipment,  Shipmentlnfo} 

TlmeOfShip  {  Month,  Wgt,  Bal,  UnitPrice  } 

FSSHASHFILE  {  Status,  Number,  Name,  Commodity,  LlnK} 

FSSSHIPFILE  {  Status,  InvoiceNo,  Name,  Origin,  Dest,  Etd, 

InvoiceDate,  TotalBales,  TotalNet,  Container. 
NofCont} 


Container  {  Number,  Bales,  Net  } 


I  |  *4* 
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FSSCONTRACT  {  same  as  FSSFILE  } 

FSSDUMMY  {  same  as  FSSFILE  } 

FSSSHIPREC  {  same  as  FSSSHIPFILE  } 

1.  1st  Normal  Form 

There  are  three  file  structures  used  In  Sales,  with  two 
repeating  groups  in  FSSFILE  (as  indicated  with  underline)  and  one 
repeating  group  in  FSSSHIPFILE.  One  temporary  file  FSSHASHFILE  is 
used  as  an  intermediate  file  to  map  into  FSSFILE  for  updating  or 
inserting  records.  This  is  not  necessary  in  the  relational  database. 

The  field  STATUS  in  FSSFILE  and  FSSSHIPFILE  is  used  to  keep 
track  of  the  space  allocation.  In  dBASE  III  PLUS,  the  APPEND  and 
INSERT  take  care  of  this.  Again  we  can  eliminate  these  from  the 
files.  The  field  SHIPMENTINFO  is  used  as  a  pointer  to  point  to  the 
shipment  information.  Actually  it  is  used  to  create  the  relationship 
between  FSSFILE  and  FSSSH1PMENT.  Again  we  can  eliminate  this, 
because  in  the  relational  database,  a  relation  can  be  created  by 
using  the  same  primary  key. 

To  put  these  files  in  INF,  the  repeating  groups  must  be 
removed  from  within  these  files.  After  1st  normalization,  we  have 
these  new  relations: 

FSSFILE  {  Number,  ContrDate,  Customer  Name,  Customer  Addr, 
Customer .  ContrNo,  Commodity,  Pricebase.  Lc  Number, 
Lc.ExpDate,  Lc.ShipDate,  Lc.Bal,  Lc.  Amount,  TotaiShip, 
BaiOfShip,  IssueBank,  DrawBank,  MitiNo,  NoiShipment  / 

FSSSHIPFILE  {  InvoiceNo,  Name,  Origin,  Dest,  Etd,  InvoiceDate, 
TotalBales,  TotalNet,  NofCont  } 

CONTAINER  {  Number,  Bales.  Net  } 

TIMEOFSHIP  {  Month,  Wgt,  Bal,  UnitPrice  } 
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We  have  separated  repeating  groups  from  files,  and  we  need 
to  create  relations  between  these  new  files.  In  T1ME0FSHIP,  the 
field  MONTH  could  be  a  primary  key,  but  the  month  can  be 
repeated  every  year.  So,  we  can  compose  NUMBER  from  FSSFILE 
with  MONTH  as  a  primary  key  (indicated  with  underline),  because 
TIMEOFSHIP  is  separated  from  FSSFILE. 

Since  we  delete  SHIPMENTINFO  (a  pointer)  from  FSSFILE,  we 
lost  the  relation  with  FSSSHIPFILE.  We  need  to  put  a  field  to 
connect  FSSFILE  and  FSSSHIPFILE.  We  can  use  the  unique  NUMBER 
in  FSSFILE  to  be  the  foreign  key  in  FSSSHIPFILE  (indicated  by 
postfixing  a  *). 

The  same  thing  happened  with  CONTAINER.  Number  can  be 
composed  from  CONTAINER  with  InvoiceNo  from  FSSFILE  as  the 
primary  key  in  CONTAINER  to  avoid  those  anomalies. 

But  here  we  have  problems  with  INF.  First,  the 
redundancy,  customer  records  are  in  FSSFILE,  and  one  customer 
can  have  many  sales  information  records  in  FSSFILE.  So  each  time 
we  have  new  sales  contract  with  the  same  customer,  we  nave  to 
put  in  the  redundant  customer's  data.  Second,  the  insertion 
anomalies,  new  customers  cannot  be  added  until  they  have  signed 
a  sales  contract  with  the  company.  Third,  deletion  anomalies, 
ielete  a  sales  contract  could  delete  all  the  information  cr  a 
customer  :t  *hat  customer  nas  only  one  sales  contract  with  *ne 
company. 

So,  we  need  to  go  through  2NF,  to  eliminate  the 

cepenaencies  mentioned  above.  We  separate  'he  customer  record 
from  FSSFILE.  Now  the  relations  are  iike  the  following. 


CUSTOMER  {  Name.  Addr,  ContrNo  } 

FSSFILE  {  Number.  ContrDate,  Commodity,  PrlceBase, 
Lc. Number,  Lc.ExpDate,  Lc.ShipDate,  Lc.Bal,  Lc. Amount, 
TotaiShip,  BaiofShip,  IssueBank,  DrawBank,  MitiNo, 
NofShlpment  } 

FSSSHIPFILE  {  InvoiceNo.  Name,  Origin,  Dest,  Etd, 
InvoiceDate,  TotalBales,  TotalNet,  NofCont,  Number*  } 

CONTAINER  {  Number.  InvoiceNo.  Baies,  Net  } 

TIMEOFSHIP  {  Number.  Month.  Wgt,  Bal,  UnitPrice  } 

3.  3rd  Normal  Form 

A  relation  is  in  3NF  if  it  is  in  2NF  and  there  is  no  transitive 
dependency.  As  we  can  see  in  the  relations  above,  there  is  no 
transitive  dependency.  These  relations  are  already  in  3NF. 

But,  the  CUSTOMER  was  just  separated  from  FSSFILE,  and 
there  is  no  relation  between  CUSTOMER  and  FSSFILE.  Perhaps  the 
field  CONTRNO  in  CUSTOMER  can  be  used  as  a  primary  key  This 
could  cause  deletion  anomalies,  if  we  delete  a  record  in  FSSFILE, 
we  might  lose  the  record  of  CUSTOMER. 

To  avoid  these  problems,  we  can  introduce  the  rieid  NaME  in 
CUSTOMER  to  be  a  foreign  key  in  FSSFILE  (indicated  by  postuxing 
with  a  *). 

CUSTOMER  {  Name.  Addr  } 

FSSFILE  Mumper.  HontrDate,  lommoaitv  F^iceBciic. 

Lc.  Number.  _c  ExpDate,  Lc.ShipDate.  _c  3at.  _c  Amount. 

TotaiShip,  BaiofShip,  IssueBank,  DrawBank,  MitiNo, 
NofShipment,  Name*  } 

FSSSHIPFILE  [  InvoiceNo.  Name.  Crigm.  Test.  S'c. 

InvoiceDate.  mtaiEaies.  ~)taiNeT.  NotOont.  'lumper* 

CONTAINER  {  Number.  InvoiceNo.  Bales,  Net  } 
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TIMEOFSHIP  { 


„  Wgt,  Bal,  UnitPrlce  } 


We  added  one  more  field  named  PhoneNo  to  CUSTOMER  to 
make  it  more  useful.  Then  we  renamed  those  file  names  and  field 
names  to  make  them  more  meaningful.  The  final  result  is: 


Customer  (  cname.  addr,  phoneno  ) 

S-Contract  (  snumber.  contrdate,  commodity,  pricebase, 

lcnumber,  lcexpdate,  leshipdate,  lcbal,  Icamount 
totalship,  balofship,  issuebank,  drawbank,  mitino, 
nofshipment,  cname*  ) 

Timeofshipment  (  month,  snumebr.  wgt,  bal,  unltprice  ) 

S-Shipment  (  lnvoiceno.  name,  origin,  dest,  etd,  invoicedate, 
totalbales,  totalnet,  nofcont,  snumber*  ) 

Container  (  cnumber.  lnvoiceno.  bales,  net  ) 

4.  Etew  E-R  Diagram 

Until  now,  we  can  draw  a  new  Entity- Relational  diagram 

(Figure  5-2)  with  the  developed  relations.  As  you  can  see  the 

Entity-Relational  diagram  of  the  new  program  is  much  more 

simple  and  readable  than  that  of  the  old  program. 

•:  Mew  Structures 

Also,  we  used  those  relations  to  create  data  structures  ior 
the  new  program  with  the  convention  of  dBASE  III  PLUS 

S-Contract 

Field  Name  Type  Width  I )S£ 
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ContrDate 

Character 

8 

Commodity 

Character 

50 

PrlceBase 

Character 

80 

LcNumber 

Character 

12 

LcExpDate 

Character 

8 

LcShlpDate 

Character 

8 

LcBal 

Numeric 

15 

2 

LcAmount 

Numeric 

15 

2 

TotalShlp 

Numeric 

15 

2 

BalofShip 

Numeric 

15 

2 

IssueBank 

Character 

30 

DrawBank 

Character 

30 

MltlNo 

Character 

18 

NofShlpment 

Numeric 

15 

CName 

Character 

25 

S- Shipment 

Field  Name 

Type 

Mdih 

Dec 

InvolceNo 

Character 

15 

Name 

Character 

25 

Origin 

Character 

25 

Dest 

Character 

25 

Etd 

Character 

8 

InvoiceDate 

Character 

8 
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TotalBales 

TotalNet 

NofContner 

SNumoer 


Figure  5-1  New  E-R  Diagram  of  Sales 

Numeric  15  2 

Numeric  15  2 

Numeric  15 

Character  12 


TlmcofShlpment 

Elfld  Name  Type 

Month  Character 

SN  umber  Character 


Width 

12 


.  s  .%  \  v 
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Wgt 

Numeric 

15 

2 

Bal 

Numeric 

15 

2 

UnitPrice 

Numeric 

15 

2 

Customer 

FteULNamg 

Type 

Width 

Jkc 

CName 

Character 

25 

Address 

Character 

50 

PhoneNo 

Character 

13 

Container 

Field  Name 

Type 

Width 

Dec 

CNumber 

Character 

12 

InvoiceNo 

Character 

15 

Bales 

Numeric 

15 

2 

Net 

Numeric 

15 

2 

B.  NORMALIZATION  OF  PURCHASE 

With  all  the  procedures  we  applied  to  the  Sales,  we  have  a 
more  simple,  more  structured  relational  database  of  Sales.  We  can 
applied  these  procedures  to  the  Purchase  too  The  following  are 
the  results  when  we  went  through  the  Purchase  with 
normalization,  E-R  diagram,  and  redefined  data  structures 

First,  we  study  the  file  structures  declared  in  the  original 
program. 

FSPF1LE  {  Status,  Number,  ContrDate,  Farmer  Name, 

Farmer  Addr,  Commodity,  TimeofShlp.  TotalShlp,  BalofShlp, 
Nofshlpment,  Shlpmentlnfo  } 

7IMEGFSHIP  'i  Month,  Wgt,  3ai,  UnitPrice  } 
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FSPHASHF1LE  {  Status,  Number,  Name,  Commodity,  Link  }  ; 

• 

FSPSHIPF1LE  {  Status,  Truck.  NofTruck,  TotalBales,  TotalNet,  j 

Payment,  TotalTruckCost,  Link  }  ! 

i 

TRUCK  {  MthDay,  WgtTlcketNo,  Bales,  Net,  Cost  }  ; 

FSPCONTRACT  {  Same  as  FSPFILE  }  j 

i 

FSPSHIPREC  {  Same  as  FSPSHIPFILE  }  1 

1.  1st  Normal  Form 

For  the  same  reasons  in  Sales,  we  deleted  FSPCONTRACT  and 
FSPSHIPREC,  and  eliminated  fields  STATUS,  LINK,  SHIPMENT1NF0. 

Besides,  the  Number  in  FSPFILE  is  purchase  number,  so  we 
substituted  with  the  new  field  name  PNumber. 

Now,  the  new  file  structures  look  like  these: 

FSPFILE  {  PNumber,  ContrDate,  Farmer. Name,  Farmer. Addr, 

Commodity,  TimeofShip.  TotalShip,  BalofShip,  Nofshipment 

} 

TIMEOFSHIP  {  Month,  Wgt,  Bal,  UnitPrice  } 

FSPSHIPFILE  {  Truck.  NofTruck,  TotalBales,  TotalNet,  Payment, 

TotalTruckCost  } 

TRUCK  {  MthDay,  WgtTlcketNo,  Bales,  Net,  Cost  } 

After  'he  1st  Normal  Form 

FSPFILE  {  PNumber,  ContrDate,  Farmer. Name,  Farmer. Addr, 

Commodity,  TotalShip,  BalofShip,  Nofshipment  } 


TIMEOFSHIP  {  Month,  Wgt,  Bat,  UnitPrice  } 


FSPSHIPFILE  {  NofTruck,  TotalBales,  TotalNet,  Payment, 
TotalTruckCost  } 


TRUCK  {  MthDay,  WgtTicketNo,  Bales,  Net,  Cost  } 


2.  2nd  Normal  Form 

After  the  2nd  Normal  Form  and  creating  the  new  relations 
with  newly  separated  files  : 

FARMER  {  Name,  Addr  } 

FSPFILE  {  Number,  ContrDate,  Farmer. Name,  Farmer. Addr, 
Commodity,  TotalShip,  BalofShip,  Nofshipment  } 

TIMEOFSHIP  {  PNumber,  Month,  Wgt,  Bal,  UnitPrice  } 

FSPSHIPFILE  {  PNumber,  PShipNo,  NofTruck,  TotalBales,  TotalNet, 
Payment,  TotalTruckCost  } 

TRUCK  {  PNumber,  PShipNo,  MthDay,  WgtTicketNo,  Bales,  Net,  Cost 

} 

3.  3rd  .Normal  Form 

Here  we  meet  the  same  problem  as  we  did  in  Sale.  The 
FARMER  just  separated  from  FSPFILE,  we  created  a  new  relation 
between  FARMER  and  FSPFILE. 

FARMER  {  Name.  Addr  } 

FSPFILE  {  PNumber,  ContrDate,  Farmer. Name,  Farmer. Addr, 

Commodity,  TotaiShip,  BalofShip,  Nofshipment,  Name*  } 

TIMEOFSHIP  {  PNumber.  Month.  Wgt,  Bal,  UnitPrice  } 

FSPSHIPFILE  {  PNumber.  PShipNo.  NofTruck,  TotalBales,  TotalNet, 

Payment,  TotalTruckCost  } 


TRUCK  { 


.,  MthDay,  WgtTicketNo,  Bales,  Net,  Cost 


lift 


U  U  U  l.l  Lii.ru 


} 

Again,  we  put  PhoneNo  in  FARMER  to  make  it  more  flexible. 
We  changed  the  file  names  and  field  names  to  make  them  more 
meaningful.  Then,  these  are  the  final  result: 

Farmer  (Jname.  addr,  phoneno  ) 

Purchase-Contract  (  pnumber.  contrdate,  commodity,  totalship, 

balofship,  nofshipment,  fname*  ) 

P_Shipment  (  pshipno.  pnumber.  nof truck,  totalbales,  totalnet, 
payment,  totaltruckcost  ) 

TimeOfShip  (  pnumber.  month,  wgt,  bal,  unitprice  ) 

Truck  (  pshipno,  pnumber.  mthday,  wgtticketno,  bales,  net,  cost  ) 


4.  New  E-R  Diagram 

With  the  new  relations,  we  draw  a  new  Entity- Relational 
diagram,  which  looks  like  the  E-R  diagram  of  Sales,  (on  next  page) 

5 . New  Data  Structures 
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Figure  5-2  New  E-R  Diagram  of  Purchase 
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VI.  STUDY  QF  MAINTAINABILITY  QF  THESE  TWO  PROGRAMS 

The  term  “maintainability"  is  used  to  describe  the  ability  of  a 
software  activity  that  occurs  following  the  delivery  of  that 
software  product  to  the  customer.  A  software  product  possesses  the 
characteristic  MAINTAINABILITY  to  the  extent  that  it  facilitates 
updating  to  satisfy  new  requirements. 

A  maintainable  software  product  is  one  which  is  understandable, 
testable,  and  easy  to  modify.  One  must  be  able  to  modify  the 
product  to  rectify  a  deficiency  or  to  add  new  capabilities  or  to 
allow  a  program  to  operate  on  a  different  computer  system. 

The  maintenance  phase  of  the  software  life  cycle  is  the  time 
period  in  which  a  software  product  performs  useful  work. 
Typically,  the  maintenance  phase  in  the  life  cycle  for  a  software 
product  spans  longer  than  that  for  the  development  phase. 

Maintainability  concerning  the  ability  of  a  software  being  making 
enhancements  to  that  software  products,  adapting  products  to  new 
environments,  and  correcting  problems.  Software  product 
enhancements  can  involve  providing  new  functional  capabilities, 
improving  user  displays,  and  modes  of  interaction,  or  upgrading 
the  performance  characteristics  of  a  system.  Adaption  of  software 
to  a  new  environment  can  involve  moving  the  software  to  a 
different  machine.  Problem  correction  involves  modification  and 
revalidation  of  software  to  correct  errors.  Also,  the  changing 
requirements  from  users  can  cost  much  in  maintaining  software. 

In  most  software  engineering  studies,  it  is  shown  that 
maintainence  activities  actually  break  into  three  main 
subactivities.  They  are  Perfective  Maintenance,  Adaptive 
Maintenance,  and  Corrective  Maintenance. 


Perfective  maintenance  is  the  act  of  improving  the  software's 
function  by  responding  to  customer-  and  programmer-detinea 
changes.  This  is  not  the  portion  of  software  maintenance  that  is 
involved  with  fixing  errors  3ut  it  is  the  biggest  maintenance  time 
consumer 

Adaptive  maintenance  is  the  act  of  changing  software  to  adapt 
to  environmental  changes  If  the  computer  on  which  the  software 
runs  is  going  to  get  a  new  version  of  the  operating  system,  or  the 
total  system  data  base  must  have  some  detail  level  changes  (for 
example,  If  the  ZIP  code  is  increased  from  five  to  nine  digits),  the 
software  must  be  adapted  to  meet  those  changes 

Corrective  maintenance  is  the  act  of  keeping  software  free  from 
errors  and  guarantees  the  integrity  of  data. 

A.  THE  ORIGINAL  PROGRAM 

1.  Maintainability  of  Record  Structures 

In  the  original  program,  the  data  structures  used  in  defining 
files  are  records  As  we  know  that  Pascal  has  very  strong  typing, 
this  means  that  the  records  used  to  define  files  have  domain 
constraints  A  domain  constraint  simply  states  that  values  of  the 
attribute  .n  question  are  required  to  belong  to  tne  set  of  vaiues 
constituting  the  underlying  domain  Here  we  discuss  the 
maintainability  of  the  original  program  and  the  new  program  by 
checking  the  record  structures  and  control  structures 
a.  Add  Fields 

Referring  to  the  records  and  rile  declarations  oi  tne  original 

program  in  Appendix  A,  we  can  summarize  them  as  follow 


fssfile  :  FILE  OF  fsstype; 
fsshashfile  :  FILE  OF  entry; 
fssshipflle  :  FILE  OF  shlptype; 
fsscontract,  fssdummy  :  fsstype; 
fssshlprec  :  shlptype, 


Now,  there  are  one  file  (i.e, .  fssfile)  and  two  file  buffers  (t,e., 
fsscontract,  fssdummy)  using  the  same  data  structures: 

fsstype  =  PACKER  RECORD 

status  :  statustype; 
number  :  string  [12]; 
contrdate  :  datetype; 
customer  :  customertype, 
commodity  :  string  [50], 
prlcebase  :  string  [80]; 
lc  :  lctype; 

tlmeofship  :  ARRAY[l.  .7]  OF  tostype; 
totalshlp,  balofship  :  real; 
lssuebank,  drawbank  :  string  [30], 
mitlno  :  string  [18], 
nof shipment  :  Integer; 
shlpmentinfo  :  integer; 

END; 

Within  this  record  structure,  there  are  five  different 
user-defined  data  types: 

statustype  =  (occupied,  empty), 

datetype  =  PACKED  RECORD 

month, 

day, 

year  .nteger 

END, 

customtype  =  PACKED  RECORD 

name  string  [25], 
addr  string  [50  ], 

contrno  string  1 12] , 

END, 
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lctype  =  PACKED  RECORD 

number  :  string  [12]; 
expdate, 

shipdate  :  datetype; 
bal,  amount  :  real; 

END; 

tostype  =  PACKED  RECORD 

month,  wgt  :  integer; 
bal,  unltprice  :  real; 

END; 

What  is  interesting  is  that  inside  lctype,  there  is  a  datetype. 
Now  datetype  has  been  referenced  in  a  different  hierarchical 
level.  Suppose  we  are  going  to  put  a  new  field,  say  TIME,  in 
datetype,  and  suppose  that  we  only  use  TIME  in  contrdate,  not 
in  lctype.  This  causes  some  troubles.  First,  we  have  to  define  a 
new  type,  say  datetlmetype,  which  has  an  extra  field  that 
contains  the  time  of  the  event.  Second,  we  need  to  write  another 
user-defined  function  to  check  datetlmetype  besides  function 
DATECHECK.  Third,  we  need  one  more  procedure  to  convert 
datetlmetype  besides  procedure  DATECONVERT.  Fourth,  after  all 
this  has  been  done,  we  need  to  recompile  the  source  program, 
redebug,  recompile,  redebug,  and  so  on.  Also,  within  FSSNEW,  in 
READNEXTINPUT,  we  have  to  modify  statements  to  meet  the  new 
data  types 

The  same  problems  occur  if  we  want  to  add  one  field, 
say  phone  number,  to  customtype. 

Now,  lets  have  a  look  at  another  file  structure  n 
Sale,  which  s  referenced  by  fssshipfile  and  fssshiprec 

shlptype  =  PACKED  RECORD 

status  statustype; 
tnvolveno  strtng(i5j, 
name, 
origin, 

dest  string  [25], 


etd, 

Involcedate  :  datatype; 
totalbales  integer; 
totalnet  :  real; 

container  :  ARRAY  [l . .  20]  OF  con  type; 
nofcont  :  0.  .20; 
link  :  Integer; 

END; 

In  this  file  type,  three  user-defined  data  types  being  referenced 

statustype  =  (occupied,  empty), 

datetype  =  PACKED  RECORD 

month, 

day, 

year  integer, 

END, 

con  type  »  PACKED  RECORD 

number  strlng[l2], 
bales  integer, 
net  :  real, 

END; 


The  same  situations  have  to  be  considered  if  we  want  to  add  fields 
into  these  three  data  types  or  the  file  type 
b  Delete  Fields 

What  will  happen  If  we  delete  the  field  year  from 
datetype,  or  delete  contrno  from  customtype  7  How  much 
trouble  can  it  cause  7  The  same  as  above  7  Will  we  lose  all  the 
data  KeDt  in  that  field7  Of  course  There  .s  no  wav  to  prevent  ‘his. 
even  an  experienced  programmer  uses  structured- programming 
techniques  such  as  Information  Hiding  The  reason  is,  Pascal  was 
designed  for  general  programming  environments,  peoples  can  use 
Pascal  to  design  an  Operating  Svstem.  or  a  compiler,  or  a  database 
system  or  any  Jtner  programs  that  meet  scientific  or  business 
requirements 
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Same  problems  happen  with  Purchase  Let's  look  at 

Appendix  A 


PURCHASE'S  FILE  DECLARATIONS 
fspflle  FILE  OF  fsptype, 
fsphashflle  FILE  OF  entry, 
fspshlpflle  FILE  OF  fspshlptype, 
fspcontract  fsptype, 
fspshiprec  fspshlptype, 

Again,  there  are  one  file  (l  e,  fspflle)  and  one  file  buffer 
(l,e  ,  fspcontract)  using  the  same  file  type 

fsptype  =  PACKED  RECORD 

status  statustvpe, 

number  stnng[l2], 

con  tr  date  datetype, 

farmer  farmertype, 

commodity  string  [50], 

tlmeofshlp  ARRAY  [l  7]  OF  tostype, 

totalship, 

balofshlp  real, 

nofshlpment, 

shlpmentlnfo  integer, 

END, 

Within  this  record  type,  there  are  five  different  user-defined  data 

types 

statustype  =  (occupied,  empty), 

latetype  -  BACKED  RECORD 
month, 

day, 

year  Integer, 

END, 

farmer'vpe  -  PACKED  RECORD 

name  string  [25], 
addr  string  [50], 


END; 


I 

( 

t  os  type  =  PACKED  RECORD  I 

month,  wgt  integer, 

bal,  unltprlce  real,  j 

END,  ! 


The  same  discussions  can  be  used  here  as  we  used  in  Sales  We 
have  the  same  conclusions 


B  THE  NEW  PROGRAM 

dBASE  111  PLUS  ts  a  versatile  database  manager  It  is  designed  to 
handle  the  many  business  applications  in  which  the  user  needs  to 
manage  large  amounts  of  repetitive  information  It  can  function  as 
a  simple  file  manager,  it  can  handle  the  complex  issues  in  relating 
files  to  one  another,  and  It  can  be  used  as  a  complete  computer 
language  like  Pascal  or  BASIC  Its  fast  development  means  that 
appropriate  Jobs  can  be  completed  in  much  less  time  with  dBASE 
III  PLUS  than  with  Pascal  or  BASIC  It  Is  possible  to  stop  and  start 
dBASE  III  PLUS  between  Instructions  and  so  have  a  microscope  Into 
the  commands  Pascal  and  BASIC  are  compiled,  so  If  things  go 
wrong,  it  is  very  nard  to  discover  wnere  the  mistake  was  made 
In  dBASE  III  PLUS,  when  changes  are  made  the  results  appear 
Instantaneously  From  the  dBASE  III  PLUS  prompt,  it  is  possible  to 
go  anvwhere  and  see  anything  Svervthing  :s  open  to  instant 
inspection  and  mange  ~his  .cind  m  power  ;an  De  .ts  iwn  problem 
dBASE  III  PLUS  nas  the  disadvantage  of  being  a  nigniy  accessible 
language  You  can  always  single  step  your  way  through  your 
command  flies,  make  never  ending,  instantaneous  changes  with 
M0D1FV  TOMMAND.  etc 

dBASE  Ill  PLUS  has  sophisticated  yet  easy  indexing  This  means 
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that  a  Ust  can  be  organized  in  several  different  ways 
simultaneously  and  that  any  item  can  be  found  in  a  fraction  of  a 
second  in  a  small  list  (says  less  than  2000  records)  and  only  a  few 
seconds  in  a  list  of  many  thousands  of  records 

dBASE  III  PLUS  is  far  from  a  perfect  programming  system 
Frequently  there  are  bugs  where  the  program  simply  does  not  do 
what  it  is  supposed  to  do 

1  Maintainability  of  Record  Structures 
a  Add  Fields 

dBASE  III  PLUS  fully  supports  the  Relational  Data  Model 
The  files  are  created  as  two  dimensional  tables  At  dBASE  111  PLUS 


dot  prompt,  just  type  in 

CREATE  <fllename> 

The  effect  of  this  action  is  that  dBASE  Ill  PLUS  sets  up  a  screen 
layout,  expecting  your  file-definition  entries  You  just  provide 
information  for  that  file  At  this  point,  dBASE  Ill  PLUS  wants  you 
to  specify  the  name  of  each  field  you  want  to  define,  the  type  of 
the  field,  the  length  of  the  field,  and  the  number  of  decimal 
places,  If  the  field  is  a  numeric  field  Here  is  an  example  of  file 
structure  CUSTOMER  used  in  sale 

Structure  for  database  A  customer  dbf 
Number  of  data  records  0 

Date  of  last  update  05/01/87 


Field 

Field  Name 

Type 

Width 

1 

'NAME 

Character 

4- 

ADDRESS 

Character 

'0 

3 

PHCNENC 

Character 

•  7 

••  Total 

*a 

89 

Perhaps  you  want  to  change  the  structure  of  one  of  the 
existing  fields,  maybe  a  name  change,  a  type  change,  or  a  length 


change),  or  perhaps  you  want  to  add  one  more  field  Into  the 
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structure  Regardless  of  the  kind  of  change  you  want,  it  would 
logical  to  make  changes  anytime  This  does  not  mean,  however 
that  you  cannot  alter  the  structure  of  an  existing  database  that 
contains  data  records  You  can  change  structures  at  any  time,  in 

any  database 

To  add  a  field  in  this  file  structure,  enter 

USE  CUSTOMER  <cr>  (Not  necessary  if  the  file  is 

already  in  use) 

MODIFY  STRUCTURE  <cr>  or 
MODI  STRU 

This  brings  up  the  structure  of  the  file  on  the  screen  Tier, 
use  the  combination  of  cursor  controls  to  add  a  new  field  When 
you  have  made  the  required  changes  to  your  structure  you  can 
either  enter  Ctrl-W  or  Ctrl-END  to  save  the  new  structure,  or 
enter  Ctrl-Q  or  ESC  to  change  your  mind  on  the  changes  made 
You  don  t  have  to  re- compile  the  program 

Of  course  if  vou  have  just  created  a  new  file  and  there 
are  no  data  records  in  it.  you  can  modifv  its  structure  at  will, 
without  any  adverse  effects  Yet,  the  most  important  consideration 
-  Future  change  cuture  changes  to  data  files  m  a  database  should 
be  anticipated  as  much  as  possible  :r.  order  to  buffer  the  amount  u 
restructuring  required  Future  changes  encompass  three  areas 
hidden  Keys,  addition  of  dependent  fields  and  high- usage  of  a 
secondary  Kev 

Hidden  Keys 

Ea  cn  ot  tne  dependent  fields  m  a  data  file  should  be 
examined  to  determined  whether  any  might 
become  Kev  fields  in  the  future  they  are 

identified,  the'/  ar.  either  :»  "?r~:  :  *-  r 

data  file  and  added  to  a  new  data  file  or  left  :r.  the 


existing  data  file,  as  long  as  flexibility  is  provided  to 
accommodate  future  key  field  changes. 

Addition  of  Dependent  Fields 

The  data  file  structures  should  have  room  for  the 
addition  of  dependent  fields.  Even  though  this  will 
require  reloading  of  the  records  whenever  new  fields 
are  added,  it  should  not  affect  the  application 

program  written. 

High- Usage  of  Secondary  Key 

If  you  anticipate  that  a  dependent  field  acting  on 
occasion  as  a  key  field  will  be  used  more  In  the 
future,  the  data  file  structures  and  application 

programs  should  be  designed  to  accomodate  change. 

This  may  require  the  dividing  of  the  data  file  into 
two  data  files  at  the  very  start,  or  the  writing  of  the 
application  programs  to  accept  this  anticipated  future 
change 

b  Delete  Fields 

To  delete  a  field  from  data  file  in  database,  the  above 
strategies  can  be  applied.  But  when  we  delete  a  field,  the  data 

retained  for  that  field  will  be  gone,  unless  you  rename  the  field 

name  or  copy  that  record  data  to  some  temporary  store  areas. 

To  delete  a  field,  we  have  to  be  cautious  about  if  it  is  a 
crrr.ar'  &ev  it  a  file  ur  not.  dBASE  III  PLUS  has  a  very  important 
ieature  ca:led  INDEXING.  Indexing  is  an  inherent  part  of  the 
dBASE  Ill  PLUS  scenario.  If  your  goal  is  to  write  sophisticated 
application  programs,  you  cannot  do  so  without  the  indexing 
‘eature1 

In  the  process  of  INDEXing,  you  inform  dBASE  III  PLUS  of 
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your  intention  to  create  an  index  file  on  one  or  more  of  the  fields 
of  the  master  file  you  are  working  with. 

Index  file  is  created  as  follow  : 

.USE  CUSTOMER  <cr> 

.  INDEX  ON  CNAME  TO  CUSTINDX  <cr> 

This  results  in  the  creation  of  a  separate  file  called  an 
index  file,  whose  name  is  CUSTINDX.  You  can  provide  any 
primary  name  you  want.  dBASE  III  PLUS  provides  the  default 
extension  of  .NDX.  An  index  file  is  just  an  index  file.  It  is  not  a 
dBASE  III  PLUS  database.  It  only  contains  pointers  to  the  actual 
records  in  the  data  files. 

Now,  suppose  you  want  to  delete  the  field  called  CNAME! 
What  is  going  to  happen?  How  can  CUSTINDX  index  on?  Will  you 
lose  all  the  data  records?  Without  that  field  which  the  index  file 
indexed  on,  you  cannot  manipulate  that  file,  like  DISPLAY,  LIST, 
PRINT,  etc, .  You  have  lost  them.  So,  before  you  delete  CNAME  you 
might  want  to  re-index  the  CUSTOMER  on  another  field.  You  can 
then  delete  CNAME. 


2. 


Pascal  is  a  block-structured  language,  and  a 
block-structured  language  requires  the  develpoment  or  new 
run-time  techniques.  Since  Pascal  procedures  can  be  recursive, 
there  can  be  several  instances  of  a  procedure  active  at  one  time. 
Hence  there  must  be  some  provision  for  the  dynamic  creation  of 
activation  records  to  hold  the  state  of  these  instances.  Therefore, 
the  static  "one  activation  record  per  procedure"  techniques  will  not 
work.  Also,  we  have  seen  that  Pascal  provides  dynamic  memory 
management  by  allocating  space  for  the  locals  of  a  procedure  on  a 
stack.  This  storage  is  allocated  on  procedure  entry  and  deallocated 
on  procedure  exit.  This  means  that  variables  cannot  be  statically 
bound  to  memory  locations  as  is  common  in  FORTRAN  and 
assembly  languages.  In  Pascal,  activation  records  represent  the 
state  of  an  activation.  Procedures  require  both  static  and  dynamic 
links.  The  static  link  is  set  to  the  environment  of  definition  and  the 
dynamic  link  points  to  its  context.  Procedural  parameters  are 
represented  by  closures.  Pascal,  Algol,  and  many  other  languages 
allow  procedures  and  functions  to  be  passed  as  arguments  to  other 
procedures  and  functions.  Allowing  functions  to  accept  and  return 
other  functions  leads  to  a  very  powerful  style  of  programming, 
called  functional  programming.  Functional  programming 
languages  must  use  a  different  discipline  for  the  allocation  and 
deallocation  of  activation  records. 

So  far,  we  have  studied  the  various  of  data  typing,  various 
discipline  of  memory  allocation  and  various  considerations  of 
procedure  calling  and  return.  We  know  once  we  have  developed  a 
program  for  one  application,  its  tied  up  to  that  application.  :t  .s 
very  difficult  to  add  one  function  or  eliminate  one  function  from 


that  program.  Because,  all  the  procedures  are  dependent  on  each 
other,  and  all  the  data  declarations,  all  the  programming  codes 
was  so  program  dependent. 


B.  MODIFIABILITY  OF  dBASE  III  PLUS 


If  you  are  modifying  the  structure  of  an  existing  database 
that  has  data-records  in  it,  note  that  you  should  choose  your 
modification  cautiously.  Consider  the  following  situation.  Suppose 
we  have  a  character  field  called  SNUMBER  that  has,  as  data,  a 
combination  of  digits  and  characters,  starting  with  digits,  and  you 
want  to  change  its  type  to  numeric.  Since  dBASE  III  PLUS  will  not 
retain  character  data  in  a  numeric  field,  at  the  end  of  the 


modification,  we  will  have  lost  all  the  character  data  from  that 


SNUMBER  field!  Only  the  leading  numerics  will  be  retained  in  the 
(new)  numeric  field.  If  the  original  data  had  leading  characters 
instead  of  numerics,  nothing  would  have  been  retained. 

If  you  change  a  field  name  and  a  field  length  at  the  same 
time,  (either  in  the  same  or  different  fields),  note  that  we  will  lose 
the  data  for  the  field(s)  with  the  name  change!  Since  dBASE  III 
PLUS  cannot  handle  this  dual-change  at  the  same  time,  make  one 
of  the  changes  first  (either  one)  and  then  make  the  other  change 
to  modify  the  structure. 

If  you  change  the  name  of  a  field  (only),  and  you  want  to 


save  this  new  structure,  dBASE  III  PLUS  will  ask  you  a  question 
"Should  data  be  COPIED  from  backup  for  ail  fields? CY/N)".  What  this 
means  is  that,  by  default,  when  you  change  the  name  of  a  field, 
you  will  lose  all  your  data  from  all  the  records  for  the  specific 
field,  at  the  end  or  modification.  By  responding  with  a  7  to  '7ns 
question,  you  can  retain  all  your  data  for  all  the  records  for  that 


field,  at  the  end  of  name-change  modification. 

To  modify  the  structure  of  the  database  you  have  created. 
Just  enter  at  the  dBASE  III  PLUS  dot  prompt  : 


.USE  CUSTOMER 

<cr> 

.MODIFY  STRUCTURE 

<cr> 

or 

.MODI  STRU 

<cr> 

MODIFY  COMMAND  is  dBASE  III  PLUS’  text  editor.  It  is  crude 
by  text-editing  standards,  but  it  has  one  major  advantage:  it  can 
be  accessed  directly  from  dBASE  III  PLUS. 

Part  of  dBASE  III  PLUS'  appeal  is  that  changes  can  be  made 
to  a  program  very  quickly.  The  MODIFY  COMMAND  allows 
programmers  to  alter  command  files  and  test  the  changes  in  as 
fast  a  way  as  possible.  It  is  especially  useful  after  a  program  is 
written,  when  the  program  then  needs  to  be  debugged.  During  this 
stage  simple  bugs,  spelling  mistakes,  and  syntax  errors 
predominate.  These  usually  require  only  a  little  thought,  and  the 
ability  to  get  to  a  text  editor  quickly  is  extremely  valuable. 

Because  it  is  a  very  simple  text  editor,  the  more  a  change 
needs  sophisticated  editing,  the  less  appealing  MODIFY  COMMAND 
will  be.  If  the  programmer  wishes  to  move  commands  from  one 
place  to  another,  to  copy  groups  of  command,  or  to  search  the 
command  file,  then  MODIFY  COMMAND  is  a  poor  tool. 

The  MODIFY  COMMAND  has  about  20  commands  It  uses 
WordStar-like  commands.  There  are  two  major  problems  with 
MODIFY  COMMAND  (In  addition  to  ail  the  features  it  lacks;  First.  :t 
only  allows  command  files  of  about  4,096  characters  If 
programmers  go  beyond  this  limit,  then  a  message  will  be  received 
saying  that  data  will  be  lost  if  they  try  to  save  the  file  Second,  if 
the  user  deletes  a  line  or  if  a  character  is  inserted  into  a  large  file, 
it  takes  an  annoyingly  long  time  to  rewrite  the  screen. 
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By  today's  standards,  the  MODIFY  COMMAND  is  crude,  and 
many  find  It  a  source  of  irritation.  But  as  an  old  dBASE  and  CBASIC 
programmer,  the  MODIFY  COMMAND  was  revolutionary  when  it 
first  appeared.  Prior  to  that,  all  programs  had  to  exit  from  their 
program  (e  g. .Pascal),  go  to  the  Operating  System,  then  to  their 
word  processor,  again  to  the  Operating  System,  and  then  back  to 
the  program.  Each  change  in  a  program  required  the  same  lengthy 
journey.  All  this  was  obviated  by  the  MODIFY  COMMAND 


Here  what  we  discuss  is  how  to  add  or  delete  an  application 
to  or  from  a  database.  There  are  tremendous  benefits  to  be  gained 
by  subdividing  a  problem  into  several  command  files  But  there  are 
some  differences  between  writing  a  single  command  file  and 
writing  a  project  in  several  command  files  These  differences  only 
concern  memory  variables  In  dBASE  III  PLUS,  they  involve  no 
restrictions  on  data  and  index  files. 

The  major  benefit  is  that  thinking  can  be  organized  by 
breaking  the  job  into  a  series  of  tasks,  each  of  which  is  performed 
by  a  command  file  This  makes  development  and  testing  easier, 
and  manes  dueling  and  deleting  functions  or  applications  easier 
Provided  that  the  task  of  dividing  the  main  task  Into  subtasks  has 
been  properly  thought  through,  the  program  will  be  more  flexible 
and  changes  will  be  easier  to  implement  than  if  the  entire  task 
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There  ,s  a  convent, on  mat  a  command  rile  tnat  caiis  anotner 
command  file  is  at  a  higher  level  The  command  file  that  is  called 
is  at  a  lower  level  than  the  command  file  calling  it  dBASE  III  PLUS 
can  move  op  r  town  the  structure  or  command  flies,  to  mg.ner  or 
lower  level  command  files  It  cannot  move  sideways 
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When  a  task  is  performed  across  a  number  of  command  files, 
dBASE  III  PLUS  generally  will  perform  more  slowly  than  if  ail 
commands  were  In  one  file.  This  Is  because  each  command  file  has 
to  be  opened  by  DOS  when  a  DO  (a  command  in  dBASE  III  PLUS)  is 
performed  and  closed  by  DOS  when  a  RETURN  is  performed  The 
time  taken  for  this  can  be  considerable  SET  PROCEDURE  will 
circumvent  the  opening  and  closing  of  files  by  DOS 

In  the  new  program,  we  subdivided  the  old  program  into 
severel  subprograms  and  tied  up  with  the  E-R  diagram  of  the  new 
program  in  five  levels  (see  Figure  5-2  and  Figure  5-3),  they  are 
HANAOKA 
SALE 

NEW  SALE  CONTRACT 

SALE  INFORMATION  INQUERY 

NEW  SALE  SHIPMENT 
SCOMPUTE 

SALE  INFORMATION  INQUERY 
LIST  CUSTOMER 

LIST  ALL  CONTRACTS  OF  ONE  CUSTOMER 
LIST  ONE  CONTRACT  INFORMATION 
SALE  L»S7 

PURCHASE 

NEW  PURCHASE  CONTRACT 

PURCHASE  INFORMATION  INGUERY 

NEW  PURCHASE  SHIPMENT 
PCOMPUTE 

PURCHASE  INFORMATION  INQUERY 
PURCHASE  LIST 
PURCHASE  SHIPMENT  -1ST 

The  name  at  each  line  represents  a  command  file  Totally 


there  are  19  command  lies  in  the  new  program.  All  the  command 
files  are  independent  of  each  other  One  command  file  has  one 
function  only,  so  It’s  easy  for  programmer  to  delete  a  command 
file  if  that  function  or  application  is  no  longer  necessary  The 
programmer  can  add  a  function  or  application  to  this  program  by 
creating  a  command  file  for  that  function  or  application 


The  increasing  productivity  of  systems  development,  the 
shortening  of  the  response  time  of  the  computer,  and  the 
increasing  complexity  of  computer  systems,  requires  effective  tools 
that  will  be  capable  of  processing  Information  Many  changes  have 
occurred  in  the  last  five  years  These  changes  are  of  two 
fundamental  types  First,  people  have  learned  how  to  better 
manage  and  use  database  technology  Five  years  ago,  companies 
were  still  wrestling  with  databases.  With  no  powerful  database 
language  available,  they  used  generic  programming  languages  to 
implement  databases  To  use  generic  programming  languages  to 
simulate  relational  database  model  or  for  any  Database 
Management  System  is  quite  a  heavy  Job.  Some  advantages  of  a 
database  must  be  sacrlfled  due  to  the  lack  of  database  features. 

In  1981,  this  situation  changed.  Some  of  the  database  languages, 
based  on  the  relational  model,  were  announced  as  products.  Early 
relational  products  had  unacceptable  performance.  In  the  last  two 
years,  performance  has  been  Improved.  Major  manufacturing 
organizations  have  tested  relational  DBMS  products  and  have  found 
segments  of  their  workload  that  can  be  processed  with  acceptable 
performance.  Using  a  relational  DBMS,  one  company  found 
application  development  productivity  improvements  to  be  greater 
than  100  to  1. 

In  this  study,  we  examined  two  programs,  one  was  written  in 
Pascal,  and  the  other  was  written  in  dBASE  III  PLUS.  We  can 
compare  the  lines  of  the  source  code  of  these  two  programs  (see 
Appendix  A  and  B).  The  original  program  is  quite  a  big  program, 
and  due  to  the  programming  structure  it  is  difficult  to  read.  In  the 


new  program,  we  see  that  Its  clear  and  it  Is  well- sequenced  so  it  is 
easier  to  read 

In  comparing  their  maintainability  and  modifiability,  the  new 
program  Is  much  easy  to  maintain,  and  easy  to  modify 


APPENDIX  A 

THE  ORIGINAL  PROGRAM  (WRITTEN  IN  APPLE  PASCAL) 
(*$S+*) 

PROGRAM  hanaoka, 

CONST  ok  =  true, 
x  =  10; 

max  =  30;  (*  size  of  hash  table  •) 
pmax  =  30, 

TYPE  characters  =  string  [80], 

numbers  -  PACKED  ARRAY  [l  .13]  OF  integer, 
menutype  =  PACKED  ARRAY  [0  9]  OF  characters, 
intype  =  PACKED  ARRAY  [0  20]  OF  characters, 
datetype  =  PACKED  RECORD 
month, 
day  , 

year  integer, 

END, 

statustype  =  (occupied,  empty), 

tostype  =  PACKED  RECORD 

month,  wgt  Integer, 
bal,  unitprlce  real 
end, 

contype  =  PACKED  RECORD 

number  string  ;  12], 
bales  integer, 

net  :  real  {integer  but  larger  than  rr.axint} 
END; 

customtype  =  PACKED  RECORD 

name  string  ( 25 1, 
addr  string  [50 1, 

rontrno  string ,12],  *  their  nr.’ri  •  ■ 

END, 

lctype  =  PACKED  RECORD 

number  string  [\2], 
expdate, 

shipdate  datetype, 
bal,  amount  real 


93 


nnwnnr 


WIIMIlWRVJ  R’WWTffWT.’F.T.ir.  »V  *-.  *-.  •-.  w.  w, 


END, 


fsstype 


PACKED  RECORD 

status  statustype, 
number  string  [12], 
contrdate  datetype, 
customer  customtype; 
commodity  string  [50], 
prlcebase  string  [80], 

1c  Ictype, 

tlmeofshlp  ARRAY  [17]  of  tostype, 
totalshlp,  balofshlp  real, 
issuebank,  drawbank  strlng[30], 
mltlno  strlng[l8], 

nofshlpment, 
shlpmentlnfo  integer, 

(*  ptr  to  the  shipments  into  ■) 

END, 


shiptype  =  PACKED  RECORD 

status  statustype, 
invoiceno  string  [15], 
name,  origin,  dest  string  [25], 
etd.tnvolcedate  datetype, 
totalbales  integer, 
totainet  real, 

container  ARRAY [l  20]  OF  contype, 
nofeont  0  20, 
link  integer, 

END 


entry  =  PACKED  RECORD 

status  statustype, 
number  strtng[l2], 
name  strmg[2S], 

rommoditv  ur  .rx  c 

;mt  nteger 

END 


farmertype  =  PACKED  RECORD 

name  strtng[25i, 
addr  stnng^O1 
END 

trucktype  =  PACKED  RECORD 
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mthday  :  string  [6], 
wgttlcketno  :  string  [12]; 
bales  :  integer; 
net,  cost  :  real, 

END; 

fsptype  =  PACKED  RECORD 

status  :  statustype; 

number  :  strlng[l2]; 

contrdate  :  datetype; 

farmer  :  farmertype; 

commodity  :  string  [50]; 

tlmeofshlp  :  ARRAY[l..7]  OF  tostype; 

totalshlp,  balofshlp  :  real, 

nofshlpment, 

shlpmentlnfo  :  integer, 

END; 

fspshlptype  =  PACKED  RECORD 

status  :  statustype, 

truck  ARRAY  [l.  20]  OF  truck  type, 

noftruck  0  20; 

totalbales  integer, 

totalnet, 

payment, 

totaltruckcost  real, 
link  integer 
END, 

VAR  fspflle  FILE  OF  fsptype, 

fsphashflle  FILE  OF  entry. 

fspshipfil*  FILE  :F  Ispsn.ptype, 

fspcontract  fsptype, 

fspshlprecord  fspshlptype, 

fssquerymenu,  error l,  error2,  fssshpmenu, 

sclname,  fdstfmenu,  fssmenu,  fspmeriu, 

fspquervmer.u.  fscshpmer.u  fsonewcor.rr.enu  menwtvpe 

rssnewconmer.  u  r. '  vtv 

:noice  nvger 

menu  TEXT. 

out  INTERACTIVE, 

digit  SET  OF  0  *  , 

continue,  quit  boolean. 

•$sf;,e  FILE  F  ' istvtv 
fsshashf'.le  FILE  F  v 
fssshipflle  FILE  OF  shiptypc 
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fsscontract,  fssdummy  fsstype, 
contractno  characters, 
shpamtlntons,  rate  real, 
fssshiprec  :  shiptype, 

FUNCTION  at (1, J .  integer) :  char :  FORWARD, 

FUNCTION  password :  boolean;  FORWARD; 

FUNCTION  datecheck  (date:  datetype) :  boolean,  FORWARD, 

FUNCTION  conint (line: characters) : Integer; FORWARD; 

FUNCTION  conrealOine.  characters) :  real;  FORWARD; 

FUNCTION  valldate(name:  characters) :  boolean;  FORWARD; 
PROCEDURE  addcomma(VAR  line: characters); FORWARD; 
PROCEDURE  dollarcent(num:  real; VAR  twodecl: characters); 
FORWARD; 

PROCEDURE  prealtostr (num :  r eal;  V AR  twodecl :  characters) ; 
FORWARD; 

PROCEDURE  skip(n: Integer), FORWARD, 

PROCEDURE  dateconvert(line:  characters;  VAR  date: datetype); 
FORWARD; 

PROCEDURE  prompt(list:menutype;n:  Integer;  VAR  select:  Integer); 
FORWARD, 

(•$1  *5: fssl. text  *) 

(*$I  *5:fss2  text  «) 

(*$I  *5  fss2  5  text  *) 

(•$1  *5  fss3  text  *) 

(*$I  *5  fspl  text  *) 

(•$1  *5  fsp2  text  •) 

FUNCTION  at, 

3E3IN 

GOTCXYU,  j), 
at  =  chr(O) 

END, 


FUNCTION  va..date, 

\R  r.  r.ar  rr.ax  .r/eger  K.;et  JET 
^  e  j  ;  *  i 

max  -  .  -  NJT’h-  name 
okset  ;  ’  A  Z  '  ♦  [  a  z) 
vandatc  faise 
FOR  .  -  1  max  X 


F  'nar 


r 


■ .  a : ' 


:e  N' 


•HEN  ex: 


N  ■  X  sv  * 


v  a . :  1  a  *  e 


at,  tl.  a 
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END, 

validate  :=  true; 

END; 

FUNCTION  conlnt; 

VAR  1, max, temp: integer;  item: char; 

BEGIN 

max  :=  LENGTH  (line);  1  :=  0;  temp  :=  0; 

REPEAT 

1  :=  i  +  1; 

Item  :=  line  [i] ; 

IF  item  IN  digit 

THEN  temp  :=  10*temp+ord(item)-ord('0') 

UNTIL  (item  =  V)  OR  (i  =  max); 
conlnt  :=  temp 
END; 

FUNCTION  conreal; 

VAR  l,J,max  :  integer;  temp  :  real;  item  :  char; 

BEGIN 

i  :=  1;  temp  :=  0;  max  :*  LENGTH  (line); 
line  :=  CONCAT(line, '  ');  [append  one  blank  so  not  to  give  the 

value  range  error  for  no.  with  no  dec  pt} 
WHILE  (1  <=  max)  AND  (llne[l]  <>  V)  DO 
BEGIN 

item  :=  line[i]; 

IF  item  IN  digit 

THEN  temp  :=  10*temp+ord(item)-ord(*0’), 
i  :=  1  +  1 
END; 

j  :=  10;  l  :=  1  +  1; 

(*  convert  the  decimal  places  if  any  *) 

WHILE  (i  <=  max)  DO 
BEGIN 

item  :=  line  [i] ; 

IF  :tem  IN  digit 

"HEN  temD  -  emc  *  -  :  •.  •• 

,  -  .  *  10: 
i  =  .  ♦ 

END. 

conreal  =  temp 
END.  (•  -or.re  v  • 
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BEGIN 

FOR  I  :=  1  TO  n  DO 
writeln(out) 

END; 

PROCEDURE  prealtostr; 

{to  change  pseudo-real  (l.e.  integer>maxlnt)  to  string} 

VAR  number  :  ARRAY [0..  9]  OF  string [l]; 

tento  :  ARRAY  [0..  5  j  OF  real; 

1,J  :  integer; 

temp  :  real; 

BEGIN 

number [0]  :=  ‘O’; number [l]  :=  T; number [2]  :=  '2'; 
number [3]  :=  '3'; number [4]  :=  '4*; number [5]  :=  *5’; 
number [6]  :=  '6';  number [7]  :=  7'; number  [8]  :=  '8'; 
number [9]  :=  ‘9‘; 

tento[0]  :=  l;tento[l]  :=  10;tento(2]  :=  100;tento[3]  : =1000; 
tento [4]  :=  10000; tento [5]  :=  100000.0; 
twodeci  :=  ' 

FOR  j  :=  5  DOWNTO  0  DO 
BEGIN 

temp  :=  TRUNC(temp); 
twodeci  :=  CONCAT(twodeci, number [i]); 
num  :=  num  -  tento  [j]*i 
END; 

{delete  the  leading  zeroes} 

WHILE  twodeci [i]  =  ‘O'  DO 
DELETE(twodeci,  1,  l); 

END;  {prealtostr} 

PROCEDURE  dollarcent; 

VAR  whole,  dec :  string  [6] ; 

number  :  ARRAY[0.,9]  OF  string [l] ; 

tento  :  ARRAY [0.. 5]  OF  real; 

i,  j  :  integer; 

temp  :  real; 

negative:  boolean; 

BEGIN 

number [0]  :=  'O';  number  [ll  :=  '1';  number [2]  :=  ’2’; 
number[3]  :=  '3,;number[4J  :=  '4';number[5]  :=  '5'; 
number [6  :=  ’6’; number [7]  :=  7'; number [8]  :=  '8'; 
number [9]  :=  '9'; 

tento[0]  :=  1;  tento[l]  :=  10;tento[2]  :=  100;tento[3}  :=  1000; 
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tento[4]  :=  10000;  tento[5]  :=  100000.0; 
whole  :=  •  ’;  dec  :=  *  *; 

IF  num  <  0 
THEN  BEGIN 

negative  :=  true; 
num  :=  -1  *  num; 

END 

ELSE  negative  :=  false; 

FOR  j  :=  5  DOWNTO  0  DO 
BEGIN 

temp  :=  num  /  tento[jJ; 

1  :=  TRUNC(temp); 
whole  :=  CONCAT(whole,  number  [i]); 
num  :=  num  -  tento[j]*i 
END; 

{delete  the  leading  zeroes} 

WHILE  whole [l]  =  '0*  DO 
DELETE(whole,  1, 1); 
num  :=  TRUNC(num  *  100.0  +  0.5); 

FOR  j  :=  1  DOWNTO  0  DO 
BEGIN 

temp  :=  num/tento[j]; 

1  :=  TRUNC(temp); 

dec  :=  CONCAT(dec, number [l]); 

num  :=  num  -  tentoLj] *1; 

END; 

IF  negative 

THEN  twodecl  :=  C0NCAT(*-\ whole,*. \ dec) 
ELSE  twodecl  :=  CONCAT(whole, *.*,dec) 

END; 

PROCEDURE  addcomma; 

VAR  1  :  integer; 

BEGIN 

IF  POS(*. ’.line)  =  0 
THEN  1  :=  2 
ELSE  i  :=  5; 

WHILE  i  <  LENGTH(line)  -  1  DO 
BEGIN 

INSERTC,  *,  line,  LENGTH(llne)  -  1); 

1  :=  1  +  4; 

END 

END; 
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PROCEDURE  dateconvert; 

VAR  temp:datetype;  max,  1:  integer;  Item  :char; 

BEGIN 

max  :=  LENGTH(line); 

temp. month  :  =  0; temp. day  :=  0; temp. year  :=  0; 
i  :»  1; 

WHILE  line[i]  <>  */'  DO 
BEGIN 

item  :=  line  [l] ; 

temp,  month  :=  temp. month  *  10  +  ord(item)  -  ord(‘0‘); 
i  :=  i  +  1; 

END; 

i  :■  l  +  1; 

WHILE  Une[i]  <>  ’/*  DO 
BEGIN 

item. day  :=  temp. day  *  10  +  ord(item)  -  ord(’O’); 

1  :*  i  +  1; 

END; 

i  :=  1  +  1; 

WHILE  i  <=  max  DO 
BEGIN 

item  :=  line [i] ; 

temp. year  :=  temp. year  *  10  +  ord(item)  -  ord(’0*); 
i  :=  i  +  1; 

END; 

date  :=  temp 
END;  (*  dateconvert  *) 

FUNCTION  datecheck; 

BEGIN 

IF  (date. month  <  1)  OR  (date,  month  >  12) 

THEN  datecheck  :=  false 
ELSE  IF  (date. day  <  1)  OR  (date,  day  >  31) 

THEN  datecheck  :=  false 
ELSE  IF  (date. year  <  60)  OR  (date. year  >  99) 

THEN  datecheck  :=  false 
ELSE  datecheck.  :  =  true 
END;  (*  datecheck  *) 

PROCEDURE  prompt; 

VAR  ch:char;  i: integer; 

BEGIN 

wrlte(chr  (12) ,  at(l5 , 1) ,  list  [0] ) ; 

FOR  1  :=  1  TO  n  DO 

write(at(10, 2*(i+l),  i, ' .  \  list  [i j ); 
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write(at(10,2*(n+2)),  ‘Selection  Please:  '); 
read(KEYBO  ARD,  ch) ; 

WHILE  (ord(ch)  <  ord(T))  OR  (ord(ch)  >  n  +  ord(‘0‘))  DO 
BEGIN  (*  range  check  for  the  selection  input  *) 

write(at(10, 2*(n+2),  'Invalid  selection', chr(7),chr(7»; 
wrlte(at(lO,  2*(n+3),  'Selection  Please: '); 
read(KEYBOARD,ch) 

END;  (*  WHILE  *) 

select  :=  ord(ch)  -  ord(’O')  (*  convert  to  integer  *) 

END;  (*  prompt  *) 

FUNCTION  password; 

CONST  valid  =  'hanaoka'; 

VAR  cnt:  integer;  secret  :  string  [7]; 

BEGIN 
cnt  :=  0; 

REPEAT 

write(chr(12),  chr(7),  at(10, 5),  'Password  : '); 
readln(KEYBOARD,  secret) ; 
cnt  :=  cnt  +  1; 

UNTIL  (secret  =  valid)  OR  (cnt  =  3); 

IF  secret  <>  valid 

THEN  password  :=  false 
ELSE  password  :=  true 
END;  (*  password  *) 

PROCEDURE  fdstfpurchase; 

VAR  quit,  successful  :  boolean; 

choice  :  integer; 

BEGIN 

(*$I-*) 

REPEAT 

RESET  (f  sphashf  ile,  ,#5:  fsphashfile'); 
successful  :=  (IORESULT=0); 

IF  NOT  successful 
THEN  BEGIN 

wrlte(chr(12), chr(7),  at(0, 4),  'Wrong  data  diskette  in 
drive  2'), 

write(at(5,0),*put  correct  one  and  press  <RETURN>’); 

readln 

END 

ELSE  CLOSE(fsphashfile) 

UNTIL  successful; 

(*SI+*) 


quit  :=  false; 

REPEAT 

prompt(fspmenu,  4,  choice) ; 

CASE  choice  OF 

1  :  fspnew; 

2  :  fspshipment; 

3  :  fspinquery; 

4  :  quit  :=  true 
END; 

UNTIL  quit 

END;  (*  fdstfpurchase  *) 

PROCEDURE  fdstfsaies; 

VAR  quit,  successful  :  boolean; 

choice  :  integer; 

BEGIN 

REPEAT 

RESET  (f  sshashf  lie,  ‘♦5:fsshashfile‘); 
successful  :  =  (IORESULT=0); 

IF  NOT  successful 
THEN  BEGIN 

write(chr(12),chr(7),at(0,4),  ’Wrong  data  diskette  in 
Drive  2*); 

wrlte(at(0, 5),  ‘put  correct  one  and  press  <RETURN>‘); 
readln 
END 

ELSE  CLOSE(fsshashfile) 

UNTIL  successful; 

(*$I+*) 
quit  :=  false; 

REPEAT 

prompt  (fssmenu,  4,  choice); 

CASE  choice  OF 

1  :  fssnew; 

2  :  fssshipment; 

3  :  fsslnquery; 

4  quit  :=  true 
END; 

UNTIL  quit 
END;  {fdstfsaies} 

PROCEDURE  initiate; 

VAR  i:  integer; 

BEGIN 
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quit  :*  false; 

digit  :=  ['O', T, '2', '3', '4', '5', '6', 7\ ’8', '9']; 

RESET(menu,  '*4:  menu,  text'); 

FOR  1  :=  0  TO  3  DO 

readln(menu,  f  dstf  menu  [i] ) ; 

FOR  1  :=  0  TO  4  DO 

readln  (menu,  f  ssmenu  [i] ) ; 

FOR  i  :=  0  TO  15  DO 

readln(menu,  fssnewconmenu  [i]); 
fspnewconmenu [l]  :=  fssnewconmenu  [l]; 
fspnewconmenu  £  :  =  fssnewconmenu  [2] ; 
fspnewconmenu  |5‘  :  =  fssnewconmenu  [6l ; 
fspnewconmenu  6  :=  fssnewconmenu  [8 j; 
fspnewconmenu [3]  :=  ’Farmer  name 
fspnewconmenu [4]  :=  'Farmer  address 
FOR  1  :=  0  TO  3  DO 
BEGIN 

readln(menu,  error  1  [l] ) ; 
error2[i]  :=  error l[i] 

END; 

error2[0]  :*  Error  !  No  such  contract  exists'; 

FOR  i  :=  0  TO  5  DO 

readln  (menu,  f  ssquerymenu  [i] ) ; 

FOR  1  :*  1  TO  6  DO 

readln  (menu,  f  ssshpmenu  [l] ) ; 

FOR  i  :=  0  TO  3  DO 

readln(menu,  sciname  [i] ) ; 

FOR  1  :=  0  TO  4  DO 

readln  (menu,  fspmenu  [i] ) ; 

FOR  i  :*  0  TO  5  DO 

readln(menu,  f  spquerymenu  [i] ) ; 

CLOSE(menu) 

END;  (*  Initialize  *) 

BEGIN  (*  main  program  *) 

Initialize; 

IF  password  =  ok  (*  password  is  the  boolean  function  *) 
THEN  REPEAT 

prompt(f  dstf  menu,  3,  choice); 

CASE  choice  OF 

1  :  fdstfsales; 

2  :  fdstfpurchase; 

3  :  quit  :*  true 
END 

UNTIL  quit 


ELSE  write(at(30, 25),  chr(7),  ‘Invalid  password'); 


END. 


SEGMENT  PROCEDURE  fssnew; 

(*  to  add  new  feed  stuff  contract  and  setup  the  data  structure 
accordingly  *) 

VAR  llneno,J,k,loc,  choice,  addr,i  :  integer; 
goon,  finish,  done,  locate  :  boolean; 
temp  :  characters;  chichar; 
tempdate  :  datetype; 

PROCEDURE  tosconvert(llne:  characters;  VAR  tos:tostype); 

CONST  blank  =  ' 

VAR  temp  :  tostype; 

1,  J,  max,  start  :  Integer; 

Item  :  characters; 

BEGIN 

line  :=  CONCAT(line,  '$  ); 
max  :  =  LENGTH  (line); 

WITH  temp  DO 
BEGIN 

month  :=  0;  wgt  :=  0;  bal  :=  0;  unitprlce  :=  0 
END; 

1  :«  l;  J  :■  i; 

REPEAT 

WHILE  (Une[i]  =  blank)  AND  (l  <  max)  DO 
1  :=  1  +  1; 

item  :=  COP Y(llne,  start,  i-start); 

CASE  J  OF 

1  :  temp. month  :=  conint(ltem); 

2  :  BEGIN 

temp,  wgt  :=  conlnt(item); 
temp. bal  :=  temp. wgt 
END; 

3  :  temp,  unitprlce  :  =  conreal(item) 

END;  (*  case  *) 

j  :*  J  +  1 

UNTIL  (J  >  3)  OR  (  i  =  max); 

tos  :=  temp 
END;  (*  tosconvert  *) 

PROCEDURE  getfssinfo; 

(*  get  all  the  information  for  the  new  contract  *) 


I 
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FUNCTION  proceed  :  boolean; 

BEGIN 

IF  EOF  THEN  BEGIN  RESET(lNPUT);EXIT(fssnew)  END 
ELSE  IF  (lineno  <>  8)  AND  (temp  =  ‘  ') 

THEN  BEGIN 

proceed  :=  false; 

%  lineno  :=  lineno  -  1; 

END 

ELSE  IF  (lineno  =  8)  AND  (temp  =  ‘  ') 

THEN  BEGIN 

proceed  :=  false; 
k  :=  k  -  1 
END 

ELSE  proceed  :=  true; 

END; 

PROCEDURE  tosinfo; 

BEGIN 

WITH  fsscontract  DO 
BEGIN 

totalship  :=  0; 

wrlte(at(x,9),'  8.  *,fssnewconmenu[8]); 
finish  :=  false;  k  :=  0; 

REPEAT 

k  :*  k  +  1; 

GOTOXY  (x+33 , 9+k) ;  readln(temp) ; 
finish  :=  (temp  =  'F')  OR  (temp  =  T); 

IF  (proceed)  AND  (NOT  finish) 

THEN  BEGIN 

tosconvert(temp,  timeof  ship  [k] ) ; 

IF(timeofship(k]. month  <  1)  OR 
(timeofship[k] .month  >  12) 

THEN  BEGIN 

write(at(x+30, 9+k),  ’Error  in  input, 
press  <RETURN>'); 

readln; 

wrlte(at(x+30,9+k), '  1 : 30); 
k  :=  k  -  1; 

END 

ELSE  totalship  :=  totalship  +  timeof  ship  [k].wgt 
END; 

UNTIL  (k=6)  OR  (finish); 
baiofship  totaiship; 

IF  k  <  6  THEN  BEGIN 

wrlte(at(x+30, 9+k), '  ’:30); 


timeof  ship  [k].  month  :=  0 

(*  0  is  endofdate  marker  *) 

END 

END 

END; 


PROCEDURE  readnextinput; 

BEGIN 

WITH  fsscontract  DO 
CASE  lineno  OF 
1,3, 4, 5, 6, 7  : 

BEGIN 

write(at(x,  lineno) ,  lineno :  2, ' .  f ssnewconmenu  [lineno] ) ; 
readln(temp); 

IF  proceed 

THEN  CASE  lineno  OF 

1  :  number  :=  temp; 

3  :  customer,  name  :=  temp; 

4  :  customer,  contrno  :=  temp; 

5  :  customer. addr  :=  temp; 

6  :  commodity  :=  temp; 

7  :  pricebase  :=  temp; 

END;  (*  case  *) 

END; 

2  :  BEGIN 

write(at(x,2),'  2.  ',f ssnewconmenu [2]); 
readln(temp); 

IF  proceed 
THEN  BEGIN 

dateconvert(temp,  contrdate); 

IF  datecheck(contrdate)  <>  ok 
THEN  BEGIN 

write(at(38,2),'Error  in  input, 
press  <RETURN>'); 

readln; 

wrlte(at(38,2),’  ' .  30) ; 
lineno  :  =  lineno  -  1; 

END 

END 

END; 

8  :  tosinfo; 

10,11  : 

BEGIN 

write(at(x,  lineno+k-*-!),  lineno:  2,  ’ .  ’, 


f  ssnewconmenu  [lineno] ) ; 

readln(temp); 

IF  proceed 
THEN  BEGIN 

dateconvert(temp,  tempdate); 

IF  datecheck  (tempdate)  <>  ok 
THEN  BEGIN 

write(at(38,line+k+l), 'Error  In  Input, 
press  <RETURN>'); 

readln; 

wrlte(at(38,  line+k+1),  •  ■ :  30); 
lineno  :=  lineno  -  1; 

END 

ELSE  BEGIN 

IF  lineno  =  10 

THEN  lc.expdate  :=  tempdate 
ELSE  lc.shipdate  :=  tempdate 
END 

END 

END; 

12  :  BEGIN 

write(at(x,  lineno+k+1), lineno: 2,  * .  fssnewconmenu [lineno] ); 
readln(temp); 

IF  proceed  THEN  BEGIN 

lc. amount  :=  conreal(temp); 
lc.bal  :=  lc. amount 
END; 

END; 

9,13,14,15  : 

BEGIN 

wrlte(at(x,  lineno+k+1) ,  lineno :  2,  ’ .  \  fssnewconmenu  [lineno] ) ; 
readln  (temp); 

IF  proceed 

THEN  CASE  lineno  OF 

9  :  lc.  number  :=  temp; 

13  :  tssuebank  :=  temp; 

14  :  drawbank  :=  temp; 

15  :  mitino  :=  temp; 

END 

END 

END  (*  case  *) 

END;  (*  readnextlnput  *) 

PROCEDURE  fssmodlfy; 

(*  to  modify  the  fsscontract  input  information  *) 


BEGIN 

REPEAT 

REPEAT 

goon  :=  true; 

write(at(55, 22), ‘Which  line  to  change:*); 
readln  (lineno);  write(at(55,22),‘  ‘ : 24); 

IF  (lineno  <  1)  OR  (lineno  >  15) 

THEN  BEGIN 

write  (at(55,22),chr(7),'No  such  linelPress  <RET>‘); 
readln; 

write(at(55,22),‘  *:25); 

goon  :=  false 

END 

UNTIL  goon; 

(*  now  erase  the  line  to  be  changed  *) 

IF  lineno  <=  6 
THEN  BEGIN 

write(at(38,  lineno), '  ‘ :  40); 

GOTOXY(38,  lineno) 

END 

ELSE  IF  lineno  =  7 
THEN  BEGIN 

wrlte(at(38, lineno),*  *:80); 

GOTOXY  (38,  lineno) 

END 

ELSE  IF  lineno  =  8 
THEN  FOR  j  :=  1  TO  k  DO 

wrlte(at(43, 9+J), '  ' :  20) 

(*  no  GOTOXY  here  since  it  is  in  PROC  seven  *) 

ELSE  BEGIN 

wrlte(at(38,lineno+k+l),’  * :  40); 

GOTOXY  (38,  llneno+k+l) 

END; 

readnextlnput; 

wrlte(at(55, 22) ,  'Ok  now? (y/n) ') ; 
read(ch); 

UNTIL  (ch  *  ‘Y‘)  OR  (ch  =  ‘y‘) 

END;  (*  fssmodify  *) 


BEGIN 

write(chr(l2),  at(l5, 0),  fssnewconmenu  [0]); 
lineno  :=  1; 

REPEAT 

readnextlnput; 
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lineno  :=  lineno  +  1; 

UNTIL  lineno  >  15; 

fsscontract.  nof shipment  :=  0;  fsscontr act. status  :=  occupied; 
write(at(55, 22) , ' Input  OK? (y/n)‘) ; 
read(ch);  IF  (ch  =  *N*)  OR  (ch  =  *n')  THEN  fssmodify 
END;  (*  getfssinfo  *) 


BEGIN  (*  fssnew  *) 

getfssinfo;  (‘input  all  pertinent  new  sales  contract  info  *) 

(*  go  thru  the  file  and  make  sure  that  the  given  contract  *  is 
not  already  in  the  file  *) 

RESET(fsshashfile,  ,#5:  fsshashfile1); 

REPEAT 

done  :=  true; 

1  :=  -1; 

REPEAT 
i  :=  i  +  1; 

SEEK(f  sshashf  lie,  i) ; 

GET  (fsshashfile) 

UNTIL  (EOF  (f sshashf ile) )  OR 

(fsshashfile".  number  =  fsscontract.  number); 

IF  fsshashfile". number  =  fsscontract. number 
THEN  REPEAT  (*  error!  same  contract  already  in  table  *) 
prompt(errorl,  3,  choice); 

CASE  choice  OF 

1  :  BEGIN  CLOSE(fsshashfile);  EXIT(fssnew)  END; 

2  :  BEGIN  CLOSE(fsshashfile);fssinquery  END; 

3  :  BEGIN 

REPEAT 

write(chr(l2),  at(x,  3),  'Contract  number 
(<ctrl-c>  to  quit):*); 
readln(fsscon  tract,  number); 

UNTIL  (fsscontract.  number  <>  '  ')  OR  EOF; 
done  :=  false; 

IF  EOF  THEN  BEGIN 

CLOSE(fsshashflle); 

RESET(INPUT); 

EXIT(fssnew) 

END 

END; 

END;  (*  case  *) 

UNTIL  choice  =  3 

(*  no  error  so  put  into  the  fssfile  and  fsshashfile  *) 

ELSE  BEGIN 


(*  place  the  new  sales  contract  info  into  the  fssfile; 

place  at  the  first  open  slot  •) 

RESET (fssfile,  ‘*5:  fssfile'); 

(*  put  the  contract  info  into  the  first  open  slot  *) 
loc  :=  -1; 

REPEAT 

loc  :=  loc  +  1; 

SEEK  (fssfile,  loc); 

GET(fssfile); 

UNTIL  (fssfile". status  =  empty)  OR  (EOF(fssfile)); 

IF  EOF (fssfile) 

THEN  BEGIN 

wrlte(chr(l2),at(x,3),'DOOMESDAY!No  more  space', 

*  to  add  new  contract'); 

write(at(x,4),'Must  use  new  diskette.  Press<RET>'); 
readln;  CLOSE(fssfile);  EXIT(fssnew) 

END; 

fssfile"  :=  fsscontract; 

SEEK  (fssfile, loc); 

PUT(fssfile);  CLOSE(fssfile); 
wrlte(at(0,22), ‘loc  *  ',loc); 

(*  find  open  slot  in  fsshashfile  *) 

RESET  (fsshashf  lie) ; 

1  :=  -1; 

REPEAT 

i  :  =  i  +  1; 

SEEK  (fsshashfile,  i); 

GET (fsshashfile); 

UNTIL  fsshashfile". status  =  empty; 

(*  put  in  the  information  *) 

WITH  fsshashfile"  DO 
BEGIN 

status  :=  occupied; 
number  :=  fsscontract. number; 
name  :  =  fsscontract.  customer,  name; 
link  :=  loc; 

commodity  :=  fsscontract.  commodity 
END; 

SEEK(fsshashfile,  i); 

PUT(fsshashfile); 

CLOSE(fsshashfile) 

END 

UNTIL  done 
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END;  (*  fssnew  *) 


SEGMENT  PROCEDURE  fssshipment; 

VAR  choice,  loc,sfloc,l,J,m,  old  :  Integer; 
done,  bankpay,  lastship  :  boolean; 
inp  :  string  [10] ; 
bankpayamt  :  real; 
ch  :  char; 

PROCEDURE  computepart; 

BEGIN 

WITH  fsscontract  DO 
BEGIN 

i  :*  1;  (8  find  out  which  months  *) 
write(chr(l2),  at(l8, 0),  'month  ©price'); 

REPEAT 

write(at(20,  l) ,  timeofship  [i] .  month :  2, '  $ ' , 

timeofshlp[i] .  unitprlce:  7:2); 

IF  tlmeof ship [i]. month  =  fssshiprec.involcedate. month 
THEN  BEGIN 
m  :=  1; 

rate  :=  tlmeof  ship  [i] .  unitprlce 
END; 

1  ;«  1  +  1; 

UNTIL  (1  >  6)  OR  (tlmeof ship  [i] .  month  =  0); 

write(at(20, 1+2),  'Compute  the  price  with  the  above  rate?(y/n)'); 
read(ch); 

IF  ch  IN  ['N\  'n'] 

THEN  REPEAT 

write(at(20, 10),  'Rate  =  ’); 

readln(inp);IF  inp  <>  '  ’  THEN  rate  :=  conreal(inp) 
UNTIL  inp  <>  '  ' 

ELSE  IF  i  >  6 
THEN  REPEAT 

write(at (30,1+3), 'But  you  must  give  me  the  rate'); 
write(at(20,10),  Rate  =  '); 

readln(lnp);  IF  inp  <>  *  ’  THEN  rate  :=  conreal(inp) 
UNTIL  inp  <>  '  '; 

shpamtlntons  :=  fssshiprec.  totalnet  /  2000; 
timeofship  [m]  .bal  :=  tlmeof  ship  [mj.bal  -  shpamtlntons; 
balofshlp  :=  baiofshlp  -  shpamtlntons; 

IF  (tlmeof ship [m], bal  <  0)  AND  (timeofship [m+l] .month  <>0) 
THEN  timeofship  [m+l]  .bal  :=  timeofship  [m+l]  .bal 
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+  tlmeofship[m] .  bal; 


IF  balofship  <  0 

THEN  lastshlp  :=  true; 
lc.bal  :=  lc.bal  -  shpamtintons  *  rate; 

IF  lc.bal  <  0 
THEN  BEGIN 

bankpay  :=  true; 
bankpayamt  :=  -lc.bal 
END; 

IF  nofshipment  <>  0 

THEN  BEGIN  (*  more  than  one  shipments  so  *) 

i  :=  0; J  :=  shipmentinfo; (*  link  up  the  shipment  records*) 

RESET(fssshipfile,  '*5:  fssshipfile'); 

REPEAT 

SEEK(fssshipfileJ);  old  :=  J; 

GET(fssshlpflle); 

J  :=  fssshipflleMink; 
i  :=  i  +  1; 

UNTIL  i  =  nofshipment; 
fssshipfile". link  :=  sfloc; 

SEEK  (fssshipfile,  old) ;  PUT(f  ssshipfile) ; 

CLOSE(fssshipflle);  (*  put  back  into  the  original  place  *) 

END 

ELSE  shipmentinfo  :=  sfloc;  (*  first  shipment  *) 
nofshipment  :=  nofshipment  +  1; 

END;  (*  with  *) 

END;  (*  computepart  *) 

BEGIN  (*  fssshipment  *) 

RESET(fsshashfile,  '*5:  fsshashftle'); 

REPEAT  (*  till  the  correct  contract  no  given  *) 
done  :=  true; 

REPEAT 

write(chr(l2),at(x, 3), 'Contract  number:  ’); 
readln(contractno) 

UNTIL  (contractno  <>  '  ')  OR  EOF; 

IF  EOF  THEN  BEGIN  RESET  (INPUT); 

CLOSE(fsshashfile);  EXIT(fssshipment)  END; 

1  :=  -l; 

REPEAT 

1  :=  i  +  1;  ; 

SEEK(fsshashfile,  i); 

GET(fsshashfile) 

UNTIL  (EOF(fsshashfile)  OR  (fsshashflle". number  =  contractno); 

IF  EOF(fsshashfile) 
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THEN  REPEAT 

prompt(error2, 3,  choice); 

CASE  choice  OF 

1  :  BEGIN  CLOSE(fsshashflle);  EXIT(fssshipment)  END; 

2  :  BEGIN  CLOSE(fsshashfile);  fsslnquery  END; 

3  :  done  :=  false 
END; 

UNTIL  choice  =  3 


ELSE  BEGIN  (*  ok  find  the  contract  info  from  fssfile  *) 
loc  :=  fsshashfile".link;  CLOSE(fsshashfile); 
RESET(fssfile,  *♦5:  fssfile*); 

SEEK  (fssfile,  loc); 

GET(fssfile);  fsscontract  :=  fssfile"; 

CLOSE(fssfile) 

END; 

UNTIL  done; 


getshipinfo; 

(*  put  this  info  into  the  fssshlpfile  *) 
bankpay  false;  lastship  :=  false; 

RESET(fssshipflle, ,#5:  fssshipfile');  sfloc  :=  -1; 

REPEAT 

sfloc  :=  sfloc  +  1; 

SEEK(fssshlpfile,  sfloc); 

GET(fssshipfile) 

UNTIL  (EOF (fssshipfile) )  OR  (fssshipfile- .  status  =  empty); 
wrlte(at(0, 22), 'sfloc  =  ',  sfloc); 


IF  EOF(fssshipfile) 

THEN  BEGIN 

CLOSE(fssshlpflle); 
write(chr(12),  chr(7),  at(x,  2), 

'DOOMESDAY  no  more  space  in  the  file'); 
write(at(x, 3), 'Please  call  the  system  designer'); 
write(at(x, 4), 'Meantime  press  <RETURN>  and 

do  other  work*); 
readln;  EXIT(fssshipment) 

END; 

fssshipfile"  :=  fssshiprec; 

SEEK(fssshipfile,  sfloc); 

PUT(fssshlpflle);  CLOSE(fssshipfile); 


(*  make  the  necessary  computation  and  save  it  «) 
computepart; 

(*  now  put  it  into  the  fssfile  *) 
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RESET(fssflle,  ,#5:  fssfile'); 
fssfile*  :=  fsscontract; 

SEEK  (fssfile, loc);  PUT(fssfile); 
CLOSE  (fssf  lie), 


shippaperwork 
END;  (*  fssshipment  *) 

SEGMENT  PROCEDURE  llsttoscreen; 

VAR  k  :  Integer;  twodecl  :  characters; 


PROCEDURE  Ilsttop;  (*  half  of  contract  Information  *) 

BEGIN 

WITH  fsscontract  DO 
BEGIN 

wrlte(chr(l2),at(l5,0),'Feed  Stuff  Sales  Contract  Information'); 
write(at(x,  1), fssnewconmenu[l] , '  number); 
write(at(x,  2) ,  fssnewconmenu  [2] , '  ‘ ,  contrdate .  month, '/' , 
contrdate .  day, '/' ,  contrdate .  year ) ; 


write(at(x,  3),  fssnewconmenu  [3 
wrlte(at(x,  4),  fssnewconmenu  [4' 
write(at(x,  5),  fssnewconmenu  [5 


wrlte(at(x,  6),  fssnewconmenu  [6] , '  commodity); 


wrlte(at  (x,  7) ,  fssnewconmenu  [7 
END; 

END;  (*  Ilsttop  *) 


'.customer. name); 

, '  ' ,  customer .  contrno) ; 
customer,  addr); 


'.prlcebase); 


PROCEDURE  Ustbottom; 

(*  bottom  half  of  fsscontract  Info  *) 

BEGIN 

WITH  fsscontract  DO 
BEGIN 
k  :=  1; 

wrlte(at(x,9), 

'Time  of  shipment  :  Months  Quantity  Balance  Unltprlce'); 
REPEAT 

write(at(29+x,  9+x),  timeofshlp  [k] .  month:  2,  timeofship  [k] .  wgt:  10, 
timeofship[k] .  bal:  12:2,*  timeofship  [k] .  unitprlce:  8: 2); 

k  :=  k  +  1 

UNTIL  (timeofship  [k].  month  =  0)  OR  (k  >  6); 
wrlte(at(x,  9+k),  'total  shipment  :  ’,totalship:8:2); 
write(at(x,10+k),  'balance  of  shipment  :  \balofship:8:2); 
wrtte(at(0, 22), 'Press  <RETURN>');  readln; 
write(at(x,  2) ,  fssnewconmenu  [10] ,  *  * ,  lc .  expdate .  month, '/' , 
lc.  expdate.  day,  '/',1c.  expdate.  year); 
wrlte(at(x, 3), fssnewconmenu [ll] , '  '.lc.shipdate.  month, '/', 
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lc.shipdate.day,  '/',1c.  shipdate .  year) ; 
dollar  cent  (lc.  amount,  twodeci) ;  addcomma  (twodeci) ; 
wrlte(at(x,  4),  fssnewconmenu  [12], '  $*, twodeci:  10); 
dollarcent(lc.  bal,  twodeci);  addcomma(twodeci); 
write(at(x, 5), ‘L/C  balance  :  $', twodeci:  10); 

write(at(x,  6),  fssnewconmenu  [13] ,  lssuebank) ; 
wrlte(at(x,  7),  fssnewconmenu  [14] ,  drawbank); 
write(at(x,  8),  faanewconmenu [15] , '  mitino); 
write(at(x,9),'#  of  shipment  made  :  ',nofshipment); 

END;  (*  with  *) 

END;  (*  llstbottom  *) 

BEGIN  {listtoscreen} 
listtop; 
llstbottom 
END; 


SEGMENT  PROCEDURE  Usttoprinter; 

VAR  i,k  :  Integer;  strl,str2,  twodeci  :  characters; 

PROCEDURE  prlisttop;  (*  half  of  contract  info  to  printer  *) 

BEGIN 

WITH  fsscontract  DO 
BEGIN 
skip  (4); 

writeln(out, '  20, 'Feed  Stuff  Sales  Contract  Information1); 
skip  (3); 

writeln(out, '  10, fssnewconmenu [l],‘  ', number); writeln(out); 

writeln(out, '  ':10, fssnewconmenu [2] , '  contrdate. month, '/', 
contrdate.  day, '/',  contrdate.  year);  writeln(out); 
wrlteln(out, '  ':10, fssnewconmenu [3],’  ', customer. name); 
wrlteln(out); 

wrlteln(out, '  MO, fssnewconmenu [4] , '  ’,  customer .  contr no); 
wrlteln(out); 

writeln(out, '  MO,  fssnewconmenu  [5] ,  ’  ’ ,  customer .  addr) ; 
writeln(out); 

writeln(out, '  MO,  fssnewconmenu [6] ,  ’  ' ,  commodity); 
writeln(out); 

IF  LENGTH (prlcebase)  <  41 

THEN  writeln(out, '  MO, fssnewconmenu [7],'  ’, prlcebase) 

ELSE  BEGIN 
i  :=  41; 

REPEAT 


UNTIL  pricebase[i]  =  '  *; 

strl  :=  COPY (prlcebase ,  1, i— i); 

str2  :=  COPY  (prlcebase,  1+1, LENGTH  (prlcebase) -1); 

writeln(out, '  ' :  10,  fssnewconmenu  [7] , '  \stri); 

writeln(out, '  ':35,str2) 

END; 

END; 

END;  (*  prllsttop  *) 

PROCEDURE  prllstbottom; 

(*  bottom  half  of  fsscontract  info  to  the  printer  *) 

BEGIN 

WITH  fsscontract  DO 
BEGIN 

skip(2);  k  :=  1; 
wrlteln(out,  *  MO, 

'Time  of  shipment  :  Months  Quantity  Balance  Unitprice'); 
REPEAT 

writeln(out, '  ' :  39,  timeofship  [k] .  month :  2,  timeofship  [k] .  wgt :  10, 
timeofship[k] .  bal:  12: 2,  ’  $' ,  tlmsofship[k] .  unitprice: 8:2); 
k  :*  k  +  1; 

UNTIL  (timeof ship [k] .  month  =  0)  OR  (k  >  6);  skip(2); 
writeln(out, '  10,  'total  shipment  :  ',  totalship:  8: 2); 
wrlteln(out); 

wrlteln(out, '  10, 'balance  of  shipment  :  \balofship:8:2); 
wrlteln(out); 

wrlteln(out,  ’  ' :  10,  fssnewconmenu  [9] , '  ',1c.  number) ;  writeln(out) ; 
wrlteln(out, '  ' :  10,  fssnewconmenu [10] , '  ', lc.  expdate.  month,  */', 
lc.  expdate.  day,  '/* , lc . expdate . year) ;  writeln(out); 
wrlteln(out, '  ':10,  fssnewconmenu  [ll] ,  ’  ',1c.  shlpdate .  month, '/' , 
lc. shlpdate. day,  '/',1c.  shlpdate. year);  writeln(out); 
dollarcent(lc.  amount,  twodecl);  addcomma(twodeci); 
wrlteln(out,  ’  ':10,  fssnewconmenu  [12] , '  $ ' ,  twodeci :  10) ; 
wrlteln(out); 

dollarcent(lc.  bal, twodeci);  addcomma (twodeci); 
wrlteln(out, '  M0, ‘L/C  balance  :$  twodeci:  10); 

wrlteln(out); 

writeln(out, '  M0,  fssnewconmenu [13] , '  ' ,  Issuebank) ; wrltein(out) ; 
writeln(out, ‘  '.10, fssnewconmenu [14],'  ’,drawbank);writeln(out); 
wrlteln(out, '  *:10, fssnewconmenu [15],'  ’,mitino);writeln(out); 
writeln(out, ’  ':10,'#  of  shipment  made  :  ',nof shipment); 

END;  (*  with  *) 

END;  (*  prllstbottom  *) 


BEGIN  {listtoprinter} 


prllsttop; 

prlistbottom 

END; 

SEGMENT  PROCEDURE  fssresiduecheck; 

VAR  J,  openent  :  Integer; 

BEGIN 

write(chr(12),at(x,  2), 'Available  Space  ); 
J  :*  0;  RESET (fssf lie,  *#5:fssflle'); 
SEEK(fssfile); 

GET (fssf  lie); 

wrlte(at(x,  4),  'Contract  file:  '); 

WHILE  NOT  EOF(fssfile)  DO 
BEGIN 

IF  fssf  lie",  status  =  empty 
THEN  BEGIN 

openent  :=  openent  +  1; 
wrlte(at(x+19, 4),  openent:  3) 
END; 

J  :■  J  +  1; 

SEEK(fssfUej); 

GET(fssfile) 

END; 

CLOSE  (fssf  lie); 
openent  :»  0;  J  :*  0; 
wrlte(at(x, 5), 'Shipment  file:  '); 

RESET  (f  ssshlpf  He,  ,#5:  fssshlpfile'); 
SEEK(fssshlpfilej);  GET(fssshipfile); 
WHILE  NOT  EOF(fssshipfile)  DO 
BEGIN 

IF  fssshipflle".  status  =  empty 
THEN  BEGIN 

openent  ;  =  openent  +  1; 
write(at(x+19, 5) ,  openent :  3) 
END; 

J  :=  J  +  l; 

SEEK(fssshlpf  lie,  J) ; 

GET(fssshlpflle) 

END; 

CLOSE(f  ssshlpf  He); 

wrtte(at(0,7),  'Press  <RETURN>’);  readln 
END;  {fssrestduechecfc} 


openent 


SEGMENT  PROCEDURE  fssinquery; 


VAR  i,J,k,num,  entries,  loc  :  integer; 
compname  :  string  [25]; 
quit  :  boolean; 

customlist  :  lntype;  ch  :  char;  twodecl,  strl,str2:  characters; 

PROCEDURE  llstship; 

VAR  sumbales,  sumnet  ;  real; 

BEGIN 

WITH  fssshiprec  DO 
BEGIN 

write(chr(12),at(0,0),'Shipname  :  ’.name); 
wrlte(at(38, 0),  'lnv  date:  involcedate.  month, 
lnvoicedate.  day, involcedate.  year); 
wrlte(at(60, 0) ,  ’etd : ' ,  etd .  month,  '/* ,  etd .  day,  7  ’ ,  etd .  year) ; 
wrlte(at(0, 1),  ‘origin  port: origin); 
wrlte(at(38, 1),  ‘destination  port:  ‘, dest); 

wrlte(at(18, 2), 'Container*',  at(33, 2), 'Bales',  at(41, 2), 'Net  wgt'); 
sumbales  :=  0;  sumnet  :=  0; 

FOR  k  :=  1  TO  nofcont  DO 
WITH  container  [k]  DO 
BEGIN 

sumbales  :=  sumbales  +  bales; 
sumnet  :=  sumnet  +  net; 
prealtostr(net,  twodecl);  addcomma(twodeciO; 
wrlte(at(l8, 3+k),  number,  at(31, 3+k),  bales:  5,  at(40, 3+k), 
twodecl:  7) 

END; 

prealtostr  (sumbales,  strl);  addcomma(strl); 
prealtostr  (sumnet,  str2);  addcomma(str2); 

wrlteln(at(31,nofcont+4), ' - ',at(40,nofcont+4),  ’ - ’); 

wrlteln(at(26,  nofcont+5),  strl:  10,  str2: 11); 

END 

END; 


PROCEDURE  prlistship; 

VAR  sumbales,  sumnet  real; 

BEGIN 

WITH  fssshiprec  DO 
BEGIN 

wrlte(at(0,20),'  ':70); 
wrlte(at(0,22),'Need  a  printout? (y/n)'); 

read(ch);  IF  EOF  THEN  BEGIN  RESET (INPUT), EXIT(prlistship)  END; 
IF  ch  IN  ['YV y] 

THEN  BEGIN 


write(at(0,22),'Tum  on  the  TEC  and  press  <RETURN>’); 
readln; 

REWRITE (out,  ‘PRINTER:  ‘);skip(4); 
wrlteln(out,  *  Shipment  No.  *,  num, 

*  Invoice  No . ' ,  f ssshlprec .  Invoiceno) ;  writeln(out) ; 

writeln(out, '  shlpname :  ' ,  name) ;  skip(2) ; 

writeln(out,  *  invoice  date:  lnvoicedate.  month,  7‘, 
invoicedate.day, lnvoicedate.  year);writeln(out); 
writein(out,  ’  etd  : etd.  month,  7',  etd.  day, 
etd.  year);  skip  (3), 

writeln(out, '  ':  18, Container  ':5, 'Bales', '  ‘:5, 

‘Net  wgt');skip(2); 
sumbales  :=  0;  sumnet  :=  0; 

FOR  k  :=  1  TO  nofcont  DO 
WITH  container  [k]  DO 
BEGIN 

sumbales  :=  sumbales  +  bales; 
sumnet  :=  sumnet  f  net; 
prealtostr(net,  twodeci);  addcomma(twodeci); 
wrlteln(out, '  18, number:  12,'  ':5,bales:5,‘  ’:5, 

twodeci:  7); 
wrlteln(out); 

END; 

prealtostr  (sumbales,  strl);  addcomma(strl); 
prealtostr(sumnet,  str2);  addcomma(str2); 

writeln(out,  *  ':35,' - y  ‘:5,‘ - ’); 

writeln(out, '  ' : 30, strl :  10, str2: 12); 

CLOSE(out) 

END 

END;  (*  with  *) 

END; 

PROCEDURE  onecontrinfo; 

PROCEDURE  case3sub; 

BEGIN 

wrlte(at(0,22),'Need  a  printout? (y/n)');read(ch); 

IF  EOF  THEN  BEGIN  RESET(INPUT);EXIT(case3sub)  END; 

IF  ch  IN  rwy*] 

THEN  BEGIN 

write(at(0,22),'Turn  on  the  TEC  and  press  <RETURN>’); 
readln;  REWRlTE(out,  ’printer: '); 
listtopr inter;  CLOSE  (out) 

END; 

IF  fsscontract.nof shipment  >  0  THEN 


BEGIN 

write  (at  (0,22), 

’Like  to  see  all  shipments  in  sequence?(y/n/<ctrl-c>  to  quit)'); 
read(ch);IF  EOF  THEN  BEGIN  RESET(INPUT);  EXIT(case3sub)  END; 
IF  ch  IN  [’Y’.’y’] 

THEN  BEGIN 

1  :=  0;  J  :=  fsscontract.shipmentinfo; 

RESET  (fssshlpfile,  '  *5:  fssshlpfile'); 

REPEAT 

SEEK(fssshipfile); 

GET  (fssshlpfile); 

J  :=  fssshlpfile". link;  i  :=  i  +  1;  num  :=  i; 
fssshlprec  :=  fssshlpfile"; 
listship;  prlistship; 

IF  1  <  fsscontract.nof shipment 
THEN  BEGIN 

write(at(0,22), 

'Want  to  see  next  shipment? (y/n)  '); 
read(ch); write(at(0, 22), '  * :  50); 

IF  EOF  THEN  BEGIN  CLOSE(fssshipfile); 
RESET(INPUT);  EXIT(case3sub)  END 
END 

UNTIL  (i  =  fsscontract.nofshipment)  OR  (ch  IN 

I'N'/n']); 

aoSE(fssshlpfile); 

END 

ELSE  BEGIN 
REPEAT 

wrlte(at(0,22),’  ’:50);  (*  erase  previous  line  *) 

REPEAT 

wrlte(at(0, 22),' Which  shlpment(<ctrl-o  to  quit):'); 
readln(num);  IF  EOF  THEN  BEGIN  RESET(INPUT); 
EXIT(case3sub)  END 
UNTIL  (num  >=  l)  AND 

(num<=f  sscon  tract .  nofshiopment); 

(*  locate  the  shipment  info  *) 

1  :*  0;  J  :=  fsscontract.shipmentinfo; 
RESET(fssshipfile,  '*5:  fssshlpfile'); 

REPEAT 

SEEK  (fssshlpfile,  J); 

GET(fssshlpfile); 

J  :=  fssshlpfile". link;  i  :=  i  +  1; 

UNTIL  i  =  num; 

fssshlprec  :=  fssshlpfile",  CLOSE(fssshipfile); 
listship;  prlistship; 


write(at(0,22),  'Like  to  see  another  $hipment?(y/n)‘); 
read  (ch);  IF  EOF  THEN  BEGIN  RESET(INPUT); 
EXIT(case3sub)  END 
UNTIL  ch  IN  ['N','n'3 
END  (*  else  *) 

END 

END;  (*  case3sub  *) 

BEGIN  (*  onecontrlnfo  *) 

REPEAT 

wrlte(chr(12),at(x,3),  'Contract  number:  *); 
readln(contractno) ; 

UNTIL  (contractno  <>  '  ')  OR  EOF;  (*  not  empty  or  terminate  *) 
IF  EOF  THEN  BEGIN  RESET(INPUT) ;  EXIT(fssinquery)  END; 
RESET(fsshashfile, ,#5:  fsshashfile');  i  :=  -1; 

REPEAT 
i  :=  1  +  1; 

SEEK  (fsshashfile,  i); 

GET(fsshashfile) 

UNTIL  (EOF(fsshashfile))  OR  (fsshashfile". number=contractno); 

IF  EOF(fsshashfile)  (*  not  found  *) 

THEN  BEGIN 

CLOSE(f  sshashf  lie) ; 

wrlte(at(x,5),chr(7),'No  such  contract  in  the  file'); 
write(at(x,7),’Press  <RETURN>‘);  readln; 

END 

ELSE  BEGIN 

CLOSE(f  sshashf  lie) ; 
loc  :=  fsshashfile*. link; 

RESET(fssfile,  ,#5:  fssfUe'); 

SEEK(fssfile,  loc);  GET(fssfile);  CLOSE(fssfile); 

fsscontract  :=  fssfile*; 

llsttoscreen; 

case3sub 

END; 

END; 

BEGIN  (*  fssinquery  *) 
quit  :=  false; 

REPEAT 

prompt  (fssquerymenu,  5,  choice) ; 

CASE  choice  OF 
1  :  BEGIN 

RESET  (fsshashfile,  ,#5:  fsshashfile’); 
write(chr(12),at(15,0),'List  of  all  customer'); 


entries  :=  1;  customlist[l]  :  =  '  j  :=  -1, 

REPEAT 
REPEAT 
J  :«  J  +  i; 

SEEK(fsshashfilej); 

GET(fsshashfile) 

UNTIL(EOF(fsshashfile))  OR 

(fsshashfileA.  status  <>  empty); 

IF  NOT  EOF(fsshashfile) 

THEN  BEGIN 
1  :=  1; 

(*  check  If  this  record's  name  is  already  in 
customers  array,  if  not  put  it  *) 
while  (Gentries)  AND  (fsshashfileA.name 

<>  customllst[l])  DO 

1  :=  1  +  1; 

IF  1  =  entries 

(*  not  in  customers  array  so  put  it  in  *) 
THEN  BEGIN 

customlist[i]  :=  fsshashfile\  name; 

entries  :=  entries  +  1 

END; 

END 

UNTIL  EOF(fsshashflle); 

CLOSE(fsshashfile);  1  :=  1; 

WHILE  1  <=  entries  -  1  DO 
BEGIN 

IF  valldate(customlist[i]) 

THEN  write(at(x,  l),  customlist  [i] ); 
i  :=  i  +  1 
END; 

wrlte(at(55,22),  'Press  <RETURN>');readln 
END; 

2  :  BEGIN 

REPEAT 

write(chr(l2),at(x,3),  'Company  name: '); 
readln(compname) 

UNTIL  (compname  <>  '  ')  OR  EOF; 

(*not  empty  or  terminate  *) 

IF  EOF  THEN  BEGIN  RESET (INPUT);  EXIT(fssinquery) 
END; 

RESET  (fsshashfile,  ,#5:fsshashfile'); 
write(chr(l2),at(l5,0), 'Contract  with  compname); 
j  :=  2; 

FOR  l  0  TO  max  DO 


BEGIN 

SEEK  (fsshashf  lie,  l); 

GET(fsshashfile); 

IF  (fsshashflle\  name  =  occupied) 

AND  (fsshashflleA.name  =  compname) 
THEN  BEGIN 

write(at(x,  j) ,  f  sshashf  ileA .  number, ' 
f  sshashf  l!eA .  commodity) ; 

J  J  +  i; 

END; 

IF  J  =  22  (*  full  screen  *) 

THEN  BEGIN 

write(at(55, 22),  'Press  <RETURN>’); 
readln;wrlte(chr(12));  J  :=  2 
END; 

END; 

wrlte(at(55,22),  'Press  <RETURN>');readln; 
CLOSE(fsshashfile) 

END; 

3  :  onecontrinfo; 

4  :  fssresiduecheck; 

5  :  quit  :=  true; 

END;  (*  case  *) 

UNTIL  quit 
END; 

SEGMENT  PROCEDURE  getshipinfo; 

VAR  k,  llneno,  xaxls  :  integer; 
ch  :  char; 

finish,  goon  :  boolean; 
temp  :  characters; 
tempdate  :  datetype; 

PROCEDURE  contcon  vert  (line:  characters;  VAR  cont:  con  type); 
CONST  blank  =  '  '; 

VAR  temp  :  contype; 

I,  J,  max,  start  :  integer; 
gross,  tare  :  real; 
item  :  characters; 

BEGIN 

line  :=  CONCAT(llne,'$'); 

WITH  temp  DO 
BEGIN 

number  :=  blank;  net  :=  0;  bales  :=  0; 

END; 


temp. number  :=  C0PY(line,l,12); 

DELETE(llne,  1,12); 

1  :=  1;  J  :=  1;  max  :=  LENGTH  (line); 

REPEAT 

WHILE  (line  [l]  =  blank)  AND  (kmax)  DO 
i  :=  i  +  1; 
start  :=  1; 

WHILE  (line  [l]  <>  blank)  AND  (l  <  max)  DO 
i  :=  1  +  1; 

item  :=  COPY (line,  start,  i-start); 

CASE  J  OF 

1  :  temp,  bales  :=  conint(item); 

2  :  gross  :=  conreal(item); 

3  :  BEGIN 

tare  :=  conreal(item); 
temp.net  :=  gross  -  tare 
END 

END;  (*  case  *) 

J  :=  J  +  1 

UNTIL  (j  >  3)  OR  (i  =  max); 
cont  :=  temp 
END; 

FUNCTION  sproceed  :  boolean; 

BEGIN 

IF  EOF  THEN  BEGIN  RESET(lNPUT);EXIT(getshipinfo)  END 
ELSE  IF  temp  =  '  ' 

THEN  BEGIN 

sproceed  :=  false; 
lineno  :=  lineno  -1 
END 

ELSE  sproceed  :=  true 

END; 

PROCEDURE  nextshipinput; 

BEGIN 

WITH  fssshlprec  DO 
BEGIN 

CASE  lineno  OF 
1  :  BEGIN 

write(at(0,0),  1.  ’,fssshpmenu[l]); 
readln(temp); 

IF  sproceed  THEN  name  :=  temp 
END; 

2,3  :  BEGIN 
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IF  lineno  =  2  THEN  xaxis  :=  38  ELSE  xaxis  :=  60; 
write(at(xaxls,  0),  lineno, ' . ' ,  f  ssshpmenu  [lineno] ) ; 
readln(temp); 

IF  sproceed 
THEN  BEGIN 

dateconvert(temp,  tempdate); 

IF  datecheck(tempdate)  <>  ok 
THEN  BEGIN 

write(at(xaxis, 0),  'Error, press  <RETURN>'); 
readln; 

wrlte(at(xaxis, 0), '  ' : 20); 
lineno  :=  lineno  -  1 
END 

ELSE  IF  lineno  =  2 

THEN  invoicedate  :=  tempdate 
ELSE  etd  :=  tempdate 
END 

END; 

4,5  :  BEGIN 

IF  lineno  =  4  THEN  xaxis  :=  0  ELSE  xaxis  :=  38; 
write(at(xaxis,  l) ,  lineno, ' . ' ,  f  ssshomenu  [lineno] ) ; 
readln(temp); 

IF  sproceed 
THEN  IF  lineno  =  4 

THEN  origin  :=  temp 
ELSE  dest  :=  temp 

END; 

END;  (*  case  *) 

IF  (lineno  >=  6) 

THEN  BEGIN 

write(at(0,2),'  \fssshpmenu[6j); 
write(at(l4, lineno-3), lineno:  2,  ‘ .  '); 
readln(temp); 

finish  :=  (temp  =  'F')  OR  (temp  =  T); 

IF  (sproceed)  AND  (NOT  finish) 

THEN  BEGIN 

contconvert(temp,  container  [lineno-5] ) ; 
write(at(56,  lineno-3),  container  [lineno-5] .  net:  3: 1); 
totalbales  :=  totalbales+contamer  [lineno-5]  .bales; 
totainet  :=  totalnet+container  [lineno-5],  net; 

IF  lineno-5  >  nofcont  THEN  nofcont  :=  lineno-5 
{necessary  not  to  reset  nofcont  when  called  from 

shipmodlfy} 

END; 

IF  finish 


K 
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THEN  wrlte(at(l4,  llneno-3),  ‘  ':60) 
END  {if} 

END  {with} 

END;  (*  nextshipinput  *) 


PROCEDURE  shipmodify; 

BEGIN 

REPEAT 

REPEAT 

goon  :=  true; 

write(at(55, 22), ‘Which  line  to  change:’); 
readln(lineno);  write(at(55, 22) ,  *  ' :  24); 

IF  (lineno  <  l)  OR  (lineno  >  fssshlprec.  nofcont  +  5) 
THEN  BEGIN 

write(at(55,22),chr(7),'No  such  line, 

press  <RETURN>‘); 
readln;wrlte(at(55,22),  ’  ’:25);  goon  :=  false 
END 

UNTIL  goon; 

(*  now  erase  the  line  to  be  changed  *) 

IF  lineno  <=  5 
THEN  CASE  lineno  OF 
1 
2 

3 

4 

5 


25) 

11) 

12) 

24) 

23); 


write(at(ll,0),' 
write(at(49,0),' 
write(at(66,0),’ 
write(at(l4, 1),' 
write(at(57, 1), ' 

END  (*  case  *) 

ELSE  WITH  fssshlprec  DO 
BEGIN 

write(at(l8,lineno-3),'  *: 60); 

totalbales  :=  totalbales  -  container [lineno-5]. bales; 

totalnet  :=  totalnet  -  container  [lineno-5].  net 

END; 

(*  read  the  modifying  line  *) 
nextshipinput; 

write(at(55,22),  'Ofc  now?(y/n )');  read(ch) 

UNTIL  ch  IN  [’Y','y‘] 

END;  (*  shipmodify  *) 


BEGIN  (*  getshipinfo  *) 

lineno  :=  1; fssshlprec. totalbales  :=  0; 
fssshiprec. totalnet  ;=  0; fssshlprec. nofcont  :=  0; 
REPEAT  {  get  the  invoice  number  } 

write(chr(12),  at(x,  3),  'Invoice  number  (append) : 
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fsscontract .  number) ; 

readln(f  ssshiprec.  invoiceno); 
f  ssshiprec.  invoiceno:  =CONCAT(fsscontract.  number, 

f  ssshiprec .  invoiceno) ; 

write(at(x,  5), 'Invoice  no.  will  be  ',f  ssshiprec.  invoiceno); 

write(at(x,6),  ‘Correct?(y/n)'); 

read(ch) 

UNTIL  ch  IN  [‘YVy'l;  wrlteln(chr(l2));  finish  :=  false; 
REPEAT 

nextshipinput; 
lineno  :=  lineno  +  1 
UNTIL  (lineno  >  25)  OR  (finish); 
f ssshiprec.  status  :=  occupied; 
write(at(55, 22),  'Input  OK?(y/n)');  read(ch); 

IF  ch  IN  ['N',  'n']  THEN  shipmodify 
END; 


SEGMENT  PROCEDURE  shlppaperwork; 

VAR  calendar  :  ARRAY[l..l2]  OF  string [9]; 

formatl,  format2,  format3,  flrsthalf,  sechalf :  characters; 
k,  choice,  l,onellne,casecnt  :  Integer; 
ch  :  char; 

PROCEDURE  signature; 

BEGIN 

sklp(3); 

wrlteln(out, '  20, ’KOBE  MERCHANTILE  ,  INC');writeln(out); 

writeln(out, '  20,  ’signed _ ’); 

wrlteln(out, '  ' : 20,  'S.  HANAOKA,  General  Manager'); 

END; 

PROCEDURE  underline(i,  j  :  integer); 

BEGIN 

write(out,'  * :  i); 

FOR  i  :=  1  TO  j  DO 
write(out, 
writeln(out) 

END; 

PROCEDURE  ashipinv; 

BEGIN 

WITH  fsscontract,  f ssshiprec  DO 
BEGIN 


3kip(8); 

writeln(out,  ’  ' :  65, calendar [involcedate.  month] , '  ', 
invoicedate .  day,  ’ ,  19 ' ,  involcedate .  year) ;  writeln(out) ; 
writeln(out,  *  ' :  7,  lnvoiceno, '  1 : 24-LENGTH(invoiceno), 
shpamtintons:7:3,'  shorttons  of,  commodity); 
writeln(out); 

writeln(out, '  ' :  43,  name);  writeln (out); 
writeln(out, '  25, calendar [etd. month],*  ‘.etd.day, *,  19', 
etd.year);  writeln(out); 

writeln(out, '  9,  origin,'  36-LENGTH  (origin),  dest); 
writeln  (out); 

writeln(out,  *  ' :  26,  customer .  name) ;  writeln(out) ; 
wrlteln(out, '  ' ;  8,  customer .  addr) ;  writeln  (out) ; 
writeln  (out, '  ' :  19,  customer .  contmo, 

'  ' : 41-LENGTH(customer .  contmo), lc.  number); 
wrlteln(out); 

writeln(out, '  * :  19, number, '  ' : 41-LENGTH(number), mitino); 
skip(5); 

wrlteln(out, '  ' :  18,  commodity); 

END 

END; 

PROCEDURE  bshipinv; 

BEGIN 

WITH  fssshiprec,  fsscontract  DO 
BEGIN 

format2  :=  prlcebase; 

WHILE  LENGTH  (format2)  >  31  DO 
{  write  prlcebase  using  2  or  3  lines  } 

BEGIN 
i  :*  31; 

REPEAT  1  :=  1  +  1  UNTIL  forma t2[i]  =  ' 
formatl  :=  C0PY(format2,l,i-l); 
format2  :=  COPY (format2, 1+1,  LENGTH(format2)-i); 
writeln(out, '  ' :  51,  formatl) 

END; 

writeln(out, '  ' :  51,  format2); 

writeln  (out, '  17, 'Container*  Bales  Net  wgt(lbs)'); 

writeln(out,  *  M7,' -  -  - *); 

FOR  K  :=  1  TO  nofcont  DO 
WITH  container  [k]  DO 
BEGIN 

prealtostr(net,  formatl);  addcomma  (formatl); 
writeln  (out, '  ' :  17,  number, '  ' :  14-LENGTH(number),  bales:  4, 
'  3, formatl:  10) 
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writeln(out, '  *:  17,  ’ _ *); 

writeln(out, '  ':3,nofcont, '  X  40  foot'); 

writeln(out, '  ' :  3,  ’CONTAINERS'); 

prealtostr  (totalnet,  formatl);  addcomma(formatlO; 

dollarcent(shpamtintons*rate,  format2);  addcomma(format2); 

STR(totalbales,  format3);  addcomma(format3); 

wrlteln(out, '  ':  17 , 'Total' , forma t3 : 6 , '  Bales  formatl:  10, 

‘  lbs’); 

wrlteln(out, '  17, formatl: 9,’  lbs=',shpamtintons:7:3, 

'  shorttons’,'  *US',rate:8:2,'  US$’,format2:10); 
WTlteln(oUt,  *  ’:  17, 

•  •:  14, '========:=======');  signature 

END 

END; 

PROCEDURE  ashippaklist; 

BEGIN 

WITH  fsscontract,  fssshiprec  DO 
BEGIN 
skip(9); 

writeln(out,  ’  ’:30,'P  ACKING  LIST’); 

writeln  (out,  ’  ' :  30, - ’);  skip (2), 

underllne(3,74); 

wrtteln(out, '  ':  3,  ’INVOICE  NO:  ’,lnvoiceno, 

’  ' :  29-LENGTH (invoiceno),  ‘DATE:  ’, 

calendar  [involcedate .  month] , '  ' ,  lnvoicedate .  day, 

’ ,  19 ' ,  involcedate .  year) ;  underline  (4,72); 
writeln(out, ’  ': 3, 'MESSRS:  '.customer. name); 
writeln(out, '  ':  11, customer. addr);skip(2);  underline^,  72); 
writeln(out, '  ':3,  'SHIPPED  PER:  '.name, '  ’:  28- LENGTH  (name), 
■SAILING  ON/OR  ABOUT:  'calendar [etd. month], '  ', 
etd .  day, ' ,  19 ' ,  etd .  year) ;  underline  (3,74); 
writeln(out, '  ':  3, 'FROM:',  origin,'  ':  35-  LENGTH  (origin) ,  TO : ' , 
dest);  underline(3,74); 

writeln(out, '  ': 3, 'MARKS  i  NOS.',’  ': 29, 'DESCRIPTION') ; 

writeln(out, '  '  3, ' - ':29, ' - '); 

skip(2); 

writeln(out, '  ' :  44, commodity); writeln (out); 

wrlteln(out,  ’  ':  33,  'Container*  Bales  Net  Weight  (lbs)') 

writeln  (out, '  ':33,' -  -  - ') 

writeln  (out); 

END 


PROCEDURE  bshippaklist; 

BEGIN 

WITH  fsscontract,  fssshlprec  DO 
BEGIN 

FOR  k  :=  1  TO  nofcont  DO 
WITH  container  [k]  DO 
BEGIN 

prealtostr(net,  formatl);  addcomma  (formatl); 
writein(out, ‘  33, number,’  ':15-LENGTH(number),baIes:6, 

’  5, formatl:  10) 

END; 

writeln(out, ’  ':33,‘ - ’); 

wrlte(out, '  3, nofcont,’  X  40  FOOT  CONTAINERS’); 

STR(totalbales,  formatl);  addcomma  (formatl); 
prealtostr(totalnet,  forma  t2);  addcomma(format2); 
wrlteln(out,  ‘  ’: 9, 'Total', formatl: 9,’  Bales’, format2: 13,  ’  lbs’); 
writeln(out, '  ':33,format2:10,  ‘  lbs  = ' ,  shpamtintons :  10 : 3 , 

'  shorttons'); 

WTlteln(oUt,  ’  ’ :  33,  ’“sssasssssssssssssssssassssss—sssss  ); 

signature 

END 

END; 

PROCEDURE  acertorlgln; 

BEGIN 

WITH  fsscontract,  fssshiprec  DO 
BEGIN 

sklp(6);  wrlteln(out, '  ' :  12,  'Shunsuke  Hanaoka’);  writeln(out); 
wrlteln(out,  Kobe  Merchantile,  Inc.,  861  Six  Ave.,’, 

'  San  Diego,  CA.  92101'); 

writeln(out);writeln(out, ’  ‘:30,’M  /  name) ;writeln (out); 
wrlte(out, '  9, calendar [etd. month],’  ’,etd.day,'  ,19', 

etd.year,'  11, customer,  name); 

IF  LENGTH  (customer,  addr)  <=  35 
THEN  BEGIN 

writeln(out, '.customer. addr); 
skip(5) 

END 

ELSE  BEGIN 
l  :=  35; 

REPEAT  i  :=  i  -  1  UNTIL  customer. addr [i]  =  ’  ’; 
firsthalf  :=  COPY(customer.addr,l,i-l); 
sechalf  :=  COP  Y  (customer,  addr,  h-1, 

LENGTH(customer.addr)-  l), 
wrlteln (out,  ’ ,  ' ,  firsthalf) ;  writeln (out) ; 
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writeln(out, '  ' ,  sechalf ) ; 
sklp(3) 

END; 

END 

END; 

PROCEDURE  bcertorlgin; 

BEGIN 

WITH  fsscontract,  fssshiprec  DO 
BEGIN 

writeln(out, '  46, commodity);  skip(3); 

FOR  k  :=  1  TO  nofcont  DO 

writeln(out,  ‘  * :  4,  container  [k] .  number) ; 
skip  (2); 

wrlteln(out, '  ':  18,  nofcont,'  X  40  FOOT'); 
prealtostr(totalnet,  format2);  addcomma(format2); 
wrlteln(out,  '  ':18,  'CONTAINERS', '  ' : 7, format2, '  lbs'); 
skip  (2); 

writeln(out, '  15, 'THESE  COMMODITIES  LICENSED  BY  THE  U.S.' 

FOR  ULTIMATE  DESTINATION'); 
writeln(out, '  ' :  15,  'JAPAN .  DIVERSION  CONTRARY  TO  U .  S . 

LAW  PROHIBITED'); 
skip(26-nofcont); 

wrlteln(out, '  ': 5, 'Chamber  of  Commerce  of  San  Diego'); 
wrlteln(out,  *  ':  41,  'California') 

END 

END;  (*  bcertorlgin  *) 

PROCEDURE  aphytocert; 

BEGIN 

WITH  fsscontract,  fssshiprec  DO 
BEGIN 

prompt(sciname,  3,  choice);  write(chr(l2)); 
skip(9);  wrlteln(out, '  *:33,  'JAPAN');  sklp(l8); 
wrlteln(out, '  ': 28, 'Kobe  Merchantlle,Inc.,  861  Six  Ave., 

San  Diego,  CA  92101'); 
wrlteln(out, '  ':  28,  customer,  name, ', '); 
writeln(out, '  ' : 28, customer. addr); wrlteln(out); 
writein(out, '  ‘:38,shpamtintons:7:3,‘  shorttons  of  ’); 
writeln(out); 

writeln(out, '  ': 38, commodity);  writeln(out); 
writeln(out, '  ': 38, sclname [choice]);  writeln(out); 
writeln(out, '  ':30,nofcont, '  X  40  Foot  Containers'); 

IF  nofcont  <=  5  THEN  wrlteln(out);  i  =0;  oneline  :=  0; 

REPEAT 
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wrlte(out,'  *  20); 
onellne  :=  onellne  +  5; 

REPEAT 
1  :=  i  +  1; 

wrlte(out,  container  [l] .  number :  LENGTH(contalner  [i] 

number),  y) 

UNTIL  (i  =  nofcont  -  1)  OR  (1  =  onellne); 

IF  1  =  nofcont  -  1 

THEN  writein(out,  container  [nofcont] .  number) 

ELSE  writeln(out) 

UNTIL  i  =  nofcont  -  1; 

IF  nofcont  <=  10  THEN  writeln(out); 

END 

END; 

PROCEDURE  bphytocert; 

BEGIN 

WITH  fsscontract,fssshiprec  DO 
BEGIN 

writeln(out, '  14,  'Imperial  County, California’); 

writeln(out); 

wrlteln(out, '  *:  21,  ‘Ocean  Vessel’, '  25,  ’Japan’); 

sklp(3); 

write(out, ’  ' :  15, ‘This  '.commodity, ’, ’, sciname [choice]), 
FOR  i  :«  1  TO  LENGTH(sciname [choice])  DO 
write(out,chr(8));  {  backspace  } 

FOR  l  :=  1  TO  LENGTH(sciname [choice])  DO 
wrlte(out,’_‘);  {  underline  }  skip(2); 

wrlteln(out, '  ’:15,'was  grown  in  the  Imperial  County, 

California.  The  Hessian  Fly,'); 

wrlteln(out); 

wrlte(out, '  ' :  15,  'Phytophaga  Destructor  (Say)'); 

FOR  1  :=  1  TO  27  DO 
write(out,chr(8)); 

FOR  i  :■  1  TO  27  DO 
write(out, '_'); 

writeln(out, '  is  not  known  to  occur  in'); writein(out), 
writein(out, '  ':15,'the  Imperial  County, California. '); 

END  {  with  } 

END; 

PROCEDURE  fumigation; 

BEGIN 

WITH  fssshiprec  DO 

BEGIN 


skip(28); 

IF  nofcont  <=  10 
THEN  FOR  k  :=  1  TO  nofcont  DO 

writeln(out, '  ' :  15,  container  [k] .  number) 

ELSE  FOR  k:  =  1  TO  10  DO 
BEGIN 

write(out,  *  ' :  15,  container  [k] .  number) ; 

IF  k+10  <=  nofcont 

THEN  writeln(out,  *  10,  container  [k+ 10].  number) 

ELSE  writein(out) 

END; 

IF  nofcont  <=  10  THEN  skip(l3-nofcont) 

ELSE  skip(3); 

i  0; 

{  seperate  the  shipname  and  voyage  number  } 

REPEAT 
1  :=  1  +  1 

UNTIL  (name[i]='V')  OR  (name[i]=,V)  OR  (1= LENGTH  (name) ) ; 
IF  (name[l]  <>  'v')  AND  (name[i]  <>  'V') 

THEN  BEGIN 

REPEAT  {  get  the  voy*  since  not  given  } 

write(chr(l2),  'No  voyage  number,  voyage  '); 
readln(format2) 

UNTIL  format2  <>  ‘  *;  formatl  :=  name; 
write(chr(l2)) 

END 

ELSE  BEGIN 

formatl  :=  COPY  (name,  1,1-1); 
format2  :=  COPY(name,i,LENGTH(name)-i+l) 

END; 

wrlteln(out, '  40,  formatl);  writeln(out); 

writeln(out, '  ' :  21,  format2,  ’  ':28,dest) 

END  {  with  } 

END; 


BEGIN 


(*  initialize  *) 
calendar  [lj  - 
calendar  [3]  .  = 
calendar  [5  :  = 
calendar  [7  :  = 
calendar  [9]  :  = 
calendar  [ll] 


Janua  ry‘; 

March', 

•May*; 

'July'; 

’September'; 

=  November'; 


calendar  [2]  = 
calendar  [4 j  ;  = 
calendar  [6]  :  = 
calendar  [8]  :  = 
calendar  [10]  : 
calendar  [12] 


'  February*  • 
April'; 
■June', 
'August*; 

=  'October'; 
'December', 


REWRITE(out,  'PRINTER: '); 
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casecnt  :=  0; 

REPEAT 

casecnt  :=  casecnt  +  1; 

CASE  casecnt  OF 

1  :  BEGIN 

wrlte(chr(12) ,  at  (0 , 3) , 

‘Turn  on  the  TEC,  Insert  the  INVOICE  sheet  and  press 

<RETURN>‘); 

readln; 

ashipinv; 

bshipinv 

END; 

2  :  BEGIN 

write(at(0,3), 

‘Now  put  the  PACKING  LIST  sheet  and  press  <RETURN>  '); 

readln; 

ashippaklist; 

bshippaklist 

END; 

3  :  BEGIN 

wrlte(at(0,3), 

'Certificate  of  Origin  sheet,  Press  <RETURN>  when  ready*); 

readln; 

acertorlgln; 

bcertorigin; 

END; 

4  :  BEGIN 

write(at(0,3), 

‘Phytosanltary  Certificate  sheet,  press  <RETURN>  when 
ready  '); 
readln; 
aphytocert; 
bphytocert 
END; 

5  .  BEGIN 

wrlte(at(0,3), 

'Fumigation  Certificate  sheet,  press  <RETURN>  when 
ready  '); 
readln, 
fumigation 
END 

END; 

write(at(0,3V  ’:78); 

write  (at  (0,3),  ’Repeat?  (y/n)‘);  read(ch); 

IF  ch  IN  ['Y'.’y']  THEN  casecnt  :=  casecnt  -  1 
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SEGMENT  PROCEDURE  fspshipment; 

VAR  choice,  loc,  sfloc,  i,  J,  m,  old,  mm  :  integer; 
done  :  boolean; 
inp  :  string  [10]; 

shpamtintons,rate,ratel,rate2,cutwgt  :  real; 
ch  :  char; 

PROCEDURE  truckconvert(line:  characters;  VAR  tr  :  trucktype); 
CONST  blank  =  ‘  '; 

VAR  temp  :  trucktype; 

i,J,  max,  start  :  integer; 
gross,  tare  :  real; 
item  :  characters; 

BEGIN 

line  :=  CONCAT(line,'$'); 

WITH  temp  DO 
BEGIN 

mthday  :=  blank; wgtticketno  :=  blank; net  :=  0; bales  :=  0 
END; 

i  :■  1;  J  :=  l;max  :=  LENGTH  (line); 

REPEAT 

WHILE(line[i]  =  blank)  AND  (i  <  max)  DO 
1  :=  i  +  1; 
start  :=  i; 

WHILE(line[i]  <>  blank)  AND  (i  <  max)  DO 
i  :=  i  +  1; 

item  :=  COPY (line, start,  1-start); 

CASE  J  OF 

1  :  temp. mthday  :=  item; 

2  :  temp. wgtticket  =  item; 

3  :  temp,  bales  :=  conint(item); 

4  :  gross  :=  conreal(item); 

5  :  BEGIN 

tare  :=  conreal(item); 
temp.net  :=  gross  -  tare 
END 

END;  (*  case  *) 

J  :=  j  +  1 

UNTIL  (J  >  5)  OR  (i  =  max), 
tr  :=  temp 
END; 

PROCEDURE  gettruckrate; 

VAR  J  :  integer;  inp  :  characters; 


BEGIN 

J  :=  0; 

REPEAT 
j  :=  J  +  1, 

CASE  j  OF 

1  :  BEGIN 

write(chr(12),at(0, 2), 'Cutting  point  weight:'); 
readln(inp); 

IF  inp  <>  '  * 

THEN  cutwgt  :=  conreal(inp) 

ELSE  J  :=  J  -  1 
END; 

2  :  BEGIN 

write(at(0,4),’Rate  below  cut  point:'); 
readln(inp); 

IF  inp  <>'  ' 

THEN  ratel  :=  conreal(inp) 

ELSE  j  :=  j  -  1 
END; 

3  :  BEGIN 

write(at(0,6), 'Rate  above  cut  point:'), 
readln(inp); 

IF  inp  <>  '  * 

THEN  rate2  :=  conreal(inp) 

ELSE  j  :=  J  -  1 
END; 

END;  {  case  } 

END;  {  gettruckrate  } 

PROCEDURE  truckcostcomp; 

VAR  truckmenu  :  menutype; 
ch  :  char; 
choice  :  Integer; 

BEGIN 

truckmenu[0j  :=  'Truck  rate  computation'; 
truckmenufl]  :=  'By  shorttons'; 
truckmenu [2]  :=  By  bales'; 
fspshiprec.  totaltruckcost  =  0; 

REPEAT 

prompt(truckmenu,  2,  choice); 

write(at(0, 10), ‘Compute  ',  truckmenu  [choice],  ’  is  it  correct? 

(y/n)'); 

read(cn) 

UNTIL  ch  IN  ['Y'.'y'], 

WITH  fspshiprec  DO 


CASE  choice  OF 

1  :  BEGIN 

{  get  the  rates  } 

REPEAT 

gettruckrate; 

wrlte(at(0, 22),' Input  OK?(y/n)'); 
read(ch);  write(at(0,22),'  *:30) 

UNTIL  ch  IN  ['YVy*]; 

{  compute  } 

FOR  i  :=  1  TO  nof truck  DO 
BEGIN 

IF  truck [i] .net/2000.0  <  cutwgt 
THEN  truck  [i] .  cost  :=  (truck  [i] .  net/2000 . 0)  *  ratel 
ELSE  truck [i] . cost  :  =  (truck [i] .net/2000.0)  *  rate2; 
totaltruckcost  :=  totaltruckcost  +  truck [i] .cost 
END 
END; 

2  :  BEGIN 

{  get  the  rates  } 

REPEAT 

gettruckrate; 

write  (at  (0,22),'  Input  OK?  (y/n) ' ) ; 
read(ch);  write  (at  (0,22), '  ':30) 

UNTIL  ch  IN  ['YVy']; 

{  compute  } 

FOR  i  :=  1  TO  noftruck  DO 
BEGIN 

IF  truck  [i] .  bales  <  cutwgt 
THEN  truck  [i] .  cost  :  =  ratel 

ELSE  truck [i] .  cost  :=  (truck [i] .  bales/cutwgt)  *  rate2; 
totaltruckcost  :=  totaltruckcost  +  truck [i] .cost 
END 
END 

END;  {  case  } 

END;  (  with  } 

END; 

PROCEDURE  fspcompute; 

BEGIN 

WITH  fspcontract  DO 
BEGIN 

i  =  i,  (*  find  out  which  months  *) 
write(chr(l2),at(l8,0), 'month  '  @price'); 

REPEAT 


write(at(20,  i),  timeof  ship  [i] .  month:  2, '  $', 

timeof  ship  [i] .  unitprice :  7 : 2); 
i  :=  i  +  1; 

UNTIL  (i  >  6)  OR  (tlmeofshipfi].  month  =  0); 

REPEAT 

write(at(20, 10), ‘Month  =  *); 
readln  (inp); 

IF  inp  <>  '  * 

THEN  BEGIN 

mm  :=  conint(lnp); 
i  :=  0; 

REPEAT 

i  :=  i  +  1;  m  :=  i; 

UNTIL  (timeofship[i].  month  =  mm)  OR  (i  *  7); 

IF  i  =  7 
THEN  BEGIN 

write(at(20,12),  ’No  such  month  listed, 
press  <RETURN>‘0; 

readln 

END 

END 

UNTIL  (timeof ship [i].  month  =  mm)  AND  (inp  <>  '  '); 

shpamtintons  ;  =  fspshiprec.  totalnet  /  2000; 
timeofship[m].bal  :=  timeof  ship  [m].bal  -  shpamtintons; 
balofship  :=  balofship  -  shpamtintons; 

fspshiprec. payment  :=  shpamtintons  *  timeofship[m],  unitprice; 

truckcostcomp;  {  compute  the  truck  cost  } 

{  now  save  into  the  fspshipfile  first  } 
fspshipfile*  :=  fspshiprec; 

SEEK  (fspshipfile,  sfloc); 

PUT  (fspshipfile) ;  CLOSE(fspshipf  ile) ; 

{  output  some  information  } 

write(chr(l2),at(0,2),  Total  of  shpamtintons: 8: 3, '  shorttons'); 
write(at(0, 4),' Payment  is  fspshiprec. payment:  10: 2); 

write  (at  (0,6),*  Press  <RETURN>‘);  readln; 

IF  (timeofship[m] .bal  <  0)  AND  (timeof ship [m+l] .month  <>  0) 
THEN  timeof  ship  [m+l]  .bal  :  =  timeof  ship  [m+l] .  bal  + 

timeofship[m]  .bal, 
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IF  nofshipment  <>  0 

THEN  BEGIN  (*  more  than  one  shipments  so  *) 

1  :=  0;j  :=  shlpmentinfo; (*  link  up  the  shipment  records  *) 
RESET (fspshipfile,  ‘*5:  fspshipfile1); 

REPEAT 

SEEK(fspshipfile,j);old  :=  j; 

GET  (fspshipfile); 

J  :=  fspshipfile*. link;  1  :=  i  +  1 
UNTIL  i  :=  nofshipment; 
fspshipfile*. link  :=  sfloc; 

SEEK  (fspshipfile,  old);  PUT(fspshipfile); 

CLOSE(fspshipfile);  (*  put  back  into  the  original  place  *) 
END 

ELSE  shlpmentinfo  :=  sfloc;  (*  first  shipment  *) 
nofshipment  :=  nofshipment  +  1; 

END;  (*  with  *) 

END;  (*  fspcompute  *) 

PROCEDURE  getpurshipinfo; 

VAR  k,  lineno,  xaxis  ;  integer; 
ch  :  char; 

finish,  goon  :  boolean; 
temp  :  characters; 
tempdate  :  datetype; 

FUNCTION  psproceed  :  boolean; 

BEGIN 

IF  EOF  THEN  BEGIN  RESET  (INPUT);  EXIT(fspshipment)  END 
ELSE  IF  temp  =  '  * 

THEN  BEGIN 

psproceed  :=  false; 
lineno  :=  lineno  -  1 
END 

ELSE  psproceed  :=  true 

END; 

PROCEDURE  nextpurshipinput; 

BEGIN 

WITH  fspshiprec  DO 
BEGIN 

wrlte(at(0,2), 

’  Date  Wgt  ticket  #  Bales  Gross  Tare  Net  '); 

wnte(at(0,  lineno+2),  lineno:  2, ' .  '); 

readln(temp), 

finish  :=  (temp  =  'F')  OR  (temp  =  TO; 
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IF  (psproceed)  AND  (NOT  finish) 

THEN  BEGIN 

truckconvert(temp,  truck  [lineno] ) ; 
write  (at  (62,  lineno+2),  truck  [lineno] .  net:  8 : 1), 
totalbales  :=  totalbales  +  truck  [lineno] .  bales; 
totalnet  :  =  totainet  +  truck  [lineno] .  net; 

IF  linenc  >  noftruck  THEN  noftruck  :=  lineno 
{nessary  not  to  reset  noftruck  when  called  from 
purshipmodify) 

END; 

IF  finish 

THEN  write(at(0,  lineno+2), 1  ':70) 

END  {  with  } 

END;  (*  nextpurshipinput  *) 

PROCEDURE  purshipmodify; 

BEGIN 

REPEAT 

REPEAT 

goon  :=  true; 

write(at(55, 22),' Which  line  to  change: '0; 
readIn(lineno);write(at(55,22), '  *:24); 

IF  (lineno  <  1)  OR  (lineno  >  fspshiprec.  noftruck) 

THEN  BEGIN 

write(at(50, 22),  chr(7),  'No  such  line,  press 

<RETURN>'); 

readln;write(at(50,22),'  ': 25);  goon  :=  false 
END 


UNTIL  goon; 

(*  now  erase  the  line  to  be  changed  *) 

WITH  fspshiprec  DO 
BEGIN 

write(at(4,  lineno+2),'  ‘ : 70); 
totalbales  :=  totalbales  -  truck  [lineno] .  bales; 
totalnet  :=  totalnet  -  truck  [lineno]  .net 
END; 

(*  read  the  modifying  line  *) 
nextpurshipinput; 

write(at(55,22),  'OK  now?(y/n)');read(ch) 

UNTIL  ch  IN  ['Y',  'y'] 

END;  (*  purshipmodify  *) 


BEGIN  (*  getpurshipinfo  *) 
lineno  :=  1;  fspshiprec.  totalbales  :=  0; 
fspshiprec. totalnet  :=  0; fspshiprec. noftruck  :=  0; 
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write(chr(l2));  {  clear  screen  } 

REPEAT 

nextpurshipinput; 

Uneno  :=  Uneno  +  1 
UNTIL  (Uneno  >  20)  OR  (finish); 
fspshiprec.  status  :=  occupied; 
write(at(55, 22),  'Input  OK?(y/n)');read(ch); 

IF  ch  IN  ['N',  *n’]  THEN  purshlpmodlfy 
END; 

BEGIN  (*  fspshipment  *) 

RESET  (fsphashfile,  '*5:  fsphashfile'); 

REPEAT  (*  till  the  correct  contract  no  given  *) 
done  :=  true; 

REPEAT 

write(chr(l2),  at(x, 3),  'Contract  number: '); 
readln  (contractno) 

UNTIL  (contractno  <>  '  ')  OR  EOF; 

IF  EOF  THEN  BEGIN  RESET  (INPUT);  CLOSE  (fsphashfile); 
EXIT(fspshipment)  END; 
i  :=  -1; 

REPEAT 
1  :=  1  =  1; 

SEEK(fsphashfile,  i); 

GET(fsphashfile) 

UNTIL  (EOF(fsphashfile))  OR  (fsphashfile" .  number  = 

contractno); 

IF  EOF(fsphashflle) 

THEN  REPEAT 

prompt(error2, 3,  choice); 

CASE  choice  OF 

1  :  BEGIN  CLOSE(fsphashfile);EXlT(fspshipment)  END; 

2  :  BEGIN  CLOSE(fsphashfile);fspinquery  END; 

3  :  done  :=  false 
END; 

UNTIL  choce  =  3 

ELSE  BEGIN  (*  ok  find  the  contract  info  from  r'spfile  *) 
loc  :=  fsphashfile". link;  CLOSE(fsphashfiie); 
RESET(fspflle,  ,#5:fspfile'); 

SEEK  (fspfile,  loc); 

GET(fspfile);  fspcontract  :=  fspfile"; 

CLOSE(fspfile) 

END; 

UNTIL  done; 
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getpurshipinfo; 

(*  put  this  info  into  the  fspshipfile  *) 

RESET(fspshlpflle, '#5:fspshipflle');sfloc  :=  -1; 

REPEAT 

sfloc  :=  sfloc  +  1; 

SEEK(fspshipfile,  sfloc); 

GET(fspshipfile) 

UNTIL  (EOF(fspshipfile))  OR  (fspshipfile*. status  =  empty); 
write(at(0, 22), 'sfloc  =  '.sfloc); 

IF  EOF(fspshipfile) 

THEN  BEGIN 

CLOSE(f  spshipf  lie) ; 
write(chr(l2),  chr(7),  at(x,  2), 

'DOOMESDAY  no  more  space  in  the  file'); 
write  (at  (x,  3),  'Please  call  the  system  designer'); 
write(at(x,  4), 'Meantime  press  <RETURN> 
and  do  other  work'); 
readln;  EXIT(fspshipment) 

END; 

(*  make  the  necessary  computation  and  save  it  *) 
fspcompute; 

(*  now  put  it  into  the  fspfile  *) 

RESET(fspfile,  ,#5:  fspfile'); 
fspfile*  :=  fspcontract; 

SEEK  (fspfile,  loc);  PUT(fspfile); 

CLOSE(fspfile); 

END;  (*  fspshipment  *) 

SEGMENT  PROCEDURE  listpurcontr;  (“purchase  contract  info  *) 
VAR  k  :  integer; 

BEGIN 

WITH  fspcontract  DO 
BEGIN 

write(chr(l2),at(l5,0),  'Feed  Stuff  Purchase  Contract 

Information  '); 

wrlte(at(x,  l),  fspnewconmenu[l] , '  number); 
write(at(x,  2),  fspnewconmenu  [2] , '  ',  contrdate.  month, '/', 
contrdate .  day, '/' ,  contrdate .  year) ; 
write(at(x,3),fspnewconmenu[3j, '  '.farmer. name); 
write(at(x, 4), fspnewconmenu [4] , ’  '.farmer. addr); 
wrlte(at(x, 5), fspnewconmenu [5] , '  '.commodity); 
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K  :=  1; 

write(at(x,6), 

'Time  of  shipment  Months  Quantity  Balance  Unltprice'); 
REPEAT 

write(at(29+x,  6+x),  tlmeofship  [k] .  month:  2,  tlmeofship  [k] .  wgt 
:  10,  tlmeofship  [k] .  bal :  12 : 2, '  $  ’ ,  tlmeofship  [k] .  unltprice :  8 : 2) ; 
k  :=  k  +  1 

UNTIL  (tlmeof ship  [k].  month  =  0)  OR  (k  >  6); 
write(at(x,6+k),  'total  shipment  :',totalship:8:2); 
wrlte(at(x,7+k), 'balance  of  shipment:  *,balofship: 8: 2); 
write(at(x,8+k),'#  of  shipment  made :',nof shipment) 

END; 

END;  (*  listpurcontr  *) 

SEGMENT  PROCEDURE  prlistpurcontr;  (*  contract  Infor  to  printer  *) 
VAR  k  :  Integer; 

BEGIN 

WITH  fspcontract  DO 
BEGIN 
skip(4); 

writeln(out, '  '; 20,  'Feed  Stuff  Purchase  Contract  Information'); 
skip(3); 

wrlteln(out, '  ':10,fspnewconmenu[l],'  ',number);wrlteln(out); 
wrlteln(out, '  ':  10,  fspnewconmenu  [2],’  ',contrdate. month, '/*, 
contrdate .  day,  7* ,  contrdate .  year) ;  writein(out) ; 
writeln(out, '  ' :  10,  fspnewconmenu  [3] , '  ' ,  farmer .  name) ; 
writeln(out); 

wrlteln(out, '  ':  10, fspnewconmenu [4],'  ', farmer. addr); 
writeln(out); 

writeln(out, '  ' :  10, fspnewconmenu [5] , '  ', commodity); 

writeln(out); 

sklp(2);  k  :=  1; 

writeln(out, '  :10, 

'Time  of  shipment  :  Months  Quantity  Balance  Unitprice’); 
REPEAT 

writeln(out, '  ':  39,  timeof  ship  [k] .month:  2,  tlmeofship  [k] . wgt:10, 
timeof ship  [k] .  bal:  12 : 2, '  $ ' ,  timeof ship  [k] .  unitprice :  3 : 2) , 
k  :=  k  +  1 

UNTIL  (timeof ship [kj. month  =  0)  OR  (k  >  6);  skip(2); 
writeln(out, '  ':  10, 'total  shipment  :',totalship:8:2); 

writeln(out); 

writeln(out, '  ':  10,  'balance  of  shipment  :  \balofship:8:2); 
writeln(out); 

writeln(out, '  '.10, of  shipment  made  . ',nofshlpment) 

END; 


O’  va’V'.'a'V 


END;  (*  prllstpurcontr  *) 


SEGMENT  PROCEDURE  purcontrinfo; 

VAR  i,j,k,num,  entries,  loc  :  integer; 
commoname  :  string  [25]; 
quit  :  boolean; 
commodlist  :  intype; 
ch  ;  char, 

twodeci,  strl,  str2,str3  :  characters; 

PROCEDURE  listpurship; 

BEGIN 

WITH  fspshiprec  DO 
BEGIN 

write(chr(l2),at(0,0),'Shipment  No.  ‘,num:2); 
write  (at  (5, 1),  'Date',  at(18, 1),  ‘Wgt  tkt**,  at(33, 1),  ’Bales’,  at(41,  l), 
’Net  Wgt',  at951,l), 'Cost'); 

FOR  k  :=  1  TO  noftruck  DO 
WITH  truck  [k]  DO 
BEGIN 

prealtostr(net,  str3);  addcomma(str3), 
write(at(5, 2+k),  mthday,  at(l8, 2+k),  wgtticketno, 
at  (31, 2+k),  bales:  5,  at  (40, 2+k) ,  str3 : 7,  cost :  9 : 2) 

END; 

STR(totalbales,  strl);  addcomma(strl); 
write(at(0,4+noftruck), 'Total  bales  strl); 
prealtostr(totalnet,  str2);  addcomma(str2); 
write(0,5+noftruck),'TotaI  net  =',str2); 
dollarcent(payment,  twodeci);  addcomma(twodeci); 
write(at(0,6+noftruck),  'Payment  =$',  twodeci); 
dollarcent(totaltruckcost,  str3);  addcomma(str3); 
write(at(0,8+noftruck), 'truck  cost  =$',str30; 

END 

END; 

PROCEDURE  printpurship; 

BEGIN 

WITH  fspshiprec  DO 
BEGIN 

write(at(0,22), '  *:70); 
wrlte(at(0,22),'Need  a  printout? (y/n)'); 

read(ch);IF  EOF  THEN  BEGIN  RESET(INPUT);EXIT(printpurship) 
END; 

IF  ch  IN  [’Y’/y] 

THEN  BEGIN 


write(at(0,22),'Turn  on  the  TEC  and  press  <RETURN>‘); 
readln; 

REWRITE(out,  'PRINTER: ');  skip(4); 

writeln(out, '  Shipment  No. ’,num:2);writeln(out); 

writeln(out, '  ':4,'Datey  ‘:14,’Wgt  ticket*','  5, 'Bales', 

1  ' :5,  'Net  Wgty  *:5,  Cost');  skip(2), 

FOR  k  :=  1  TO  noftruck  DO 
WITH  truck  [k]  DO 
BEGIN 

prealtostr(net,  str3);  addcomma(str3); 
writeln(out, '  ' : 4, mthday, '  ' :  12,  wgtticketno.  12, 

'  5, bales: 5,  *  ':5,str3:7,'  ': 5, cost: 7: 2), 

writeln(out) 

END; 

STR(totalbales,  strl);  addcomma(strl); 
prealtostr(totalnet,  str2);  addcomma(str2); 
dollarcent(totaltruckcost,  str3);  addcomma(str3); 
dollarcent(payment,  twodeci);  addcomma(twodeci); 
writeln(out); 

writeln(out, '  ': 5, 'Total  bales  =',strl),writein(out), 
writeln(out, '  ':5, 'Total  net  =',str2); writeln(out), 
writeln(out, '  ':5, 'Payment  =$', twodeci:  10); writeln(out); 
wrlteln(out, '  ':5,'Truck  cost  =$’,str3: 10); 

COLSE(out) 

END 

END;  (*  with  *) 

END; 

PROCEDURE  subpurcontr;  {  for  shipment  info  } 

BEGIN 

IF  fspcontract.nof shipment  >  0  THEN 
BEGIN 

write(at,  (0,22), 

'Like  to  see  all  shipments  in  sequence? (y/n/<ctrl-c>  to  quit)'); 
read (ch);  IF  EOF  THEN  BEGIN  RESET(INPUT);EXIT(subpurcontr) 
END; 

IF  ch  IN  ['Y\'y'] 

THEN  BEGIN 

i  :=  0;  j  :=  f spcon tract,  shipmentinfo; 

RESET  (f  spshipf  lie,  ',#5:fspshipflle'); 

REPEAT 

SEEK(fspshipfile,j); 

GET^fspshipfile); 
j  :=  fspshipfileMink; 
fspshiprec  :=  fspshipfile"; 


num  :*  i  +  1;  {  used  in  printing  proc  } 
listpurship;  printpurship;  i  :=  i  +  1; 

IF  i  <  fspcontract.nofshipment 
THEN  BEGIN 

write(at(0,22),‘Want  to  see  next  shipment? 

(y/n)  '); 

read(ch);write(at(0,22),'  ' : 50); 

IF  EOF  THEN  BEGIN  CLOSE(fspshipfile); 

RESET(INPUT); 
EXIT(subpurcontr)  END 

END 

UNTIL  (i  =  fspcontract.nofshipment)  OR  (ch  IN  ['N’,’n']); 
CLOSE(f  spshipfile) ; 

END 

ELSE  BEGIN 

REPEAT 

wrlte(at(0, 220, 1  ' :  70);  (*  erase  previous  line  *) 

REPEAT 

wrlte(at(0, 22), 'Which  shipment (<ctrl-c>  to  quit):’); 
read  (num),  IF  EOF  THEN  BEGIN  RESET (INPUT); 

EXIT  (subpurcontr) 

END 

UNTIL  (num>=l)  AND 

(num<=fspcontract.  nof  shipment), 

(*  locat  the  shipment  info  *) 

1  :=  0;  J  :=  fspcontract.shipmentinfo; 

RESET (fspshipfile,  '*5:  fspshipfile'); 

REPEAT 

SEEK  (fspshipfile,  J) ; 

GET  (fspshipfile); 

J  :»  fspshipfile". link;  i  :=  i  +  1 
UNTIL  i:=  num, 

fspshiprec  :=  fspshipfile",  CLOSE  (fspshipfile); 
listpurship;  printpurship; 

wrlte(at(0,22),  'Like  to  see  another  shipment? (y/n)'); 
read(ch); 

IF  EOF  THEN  BEGIN  RESET(INPUT);EXIT(subpurcontr) 
END 

UNTIL  ch  IN  ['y','Y'] 

END  (*  else  *) 

END 

END; 

BEGIN  (*  purcontrinfo  *) 

REPEAT 


write(chr(l2),at(x,3),  'Contract  number:  ’); 
readln(contractno) ; 

UNTIL  (contractno  <>  ’  ')  OR  EOF;  (*  not  empty  or  terminate  *) 

IF  EOF  THEN  BEGIN  RESET(lNPUT);EXIT(purcontrinfo)  END, 
RESET(fsphashfile,  ,#5:fsphashfile');  i  :=  -  1; 

REPEAT 

i  :=  i  +  1; 

SEEK(fsphashfile,  l); 

GET(fsphashfile) 

UNTIL  (EOF(fsphashfile)  OR  (fsphashfile\ number  =  contractno); 

IF  EOF(fsphashfile)  (*  not  found  *) 

THEN  BEGIN 

CLOSE(fsphashfile); 

write(at(x,5),chr(70,'No  such  contract  in  the  file'); 
wrlte(at(x,7),'Press  <RETURN>');  readln; 

END 

ELSE  BEGIN 

CLOSE  (fsphashf  lie); 
loc  :=  fsphashfileMink; 

RESET (fspfile,  '*5:  fspfile'); 

SEEK(fspfile,  loc);  GET(fspfile);  CLOSE(fspfile); 

fspcontract  :=  fspfile*; 

listpurcontr; 

{  prntout  to  the  printer  if  desired  } 

write  (at  (0 , 22) ,  ’  Need  a  printout?  (y/n) ) ;  read  (ch) ; 

IF  EOF  THEN  BEGIN  RESET(INPUT);EXIT(purcontrinfo)  END; 
IF  ch  IN  ['YVy*] 

THEN  BEGIN 

write(at(0,22),'Turn  on  the  TEC  and  press 

<RETURN>'); 

readln;  REWRITE(out,  'PRINTER: '); 
prlistpurcontr;  CLOSE(out) 

END; 

subpurcontr  {  to  list/print  shipment  information  } 

END, 

END; 

SEGMENT  PROCEDURE  fspresiduecheck; 

VAR  J.opencnt  :  Integer; 

BEGIN 

write(chr(l2),at(x, 2), ‘Available  Spaces');  opencnt  :=  0; 
write(at(x, 4),  'Contract  file:  '); 
j  :=  0;  RESET  (fspfile,  ,#5.fspfiel'); 

SEEK(fspfilej);  GET(fspfile); 


WHILE  NOT  EOF(fspflle)  DO 
BEGIN 

IF  fspfile".  status  =  empty 
THEN  BEGIN 

opencnt  :=  opencnt  +  1; 
write(at(x+19, 4),  opencnt:  3) 

END; 

J  :*  J  +  l; 

SEEK(fspfilej); 

GET(fspflle) 

END; 

CLOSE(fspfile); 
opencnt  :*  0;  j  :=  0; 
write(at(x, 5), 'Shipment  file:  '); 

RESET (fspshipfile,  ,#5:  fspshipfile'); 

SEEK  (fspshipfile,  J) ;  GET(fspshlpfile) ; 

WHILE  NOT  EOF  (fspshipfile)  DO 
BEGIN 

IF  fspshipfile". status  =  empty 
THEN  BEGIN 

opencnt  :=  opencnt  +  1; 
write(at(x+19, 5),  opencnt:  3) 

END; 

J  :=  J  +  l; 

SEEK  (fspshipfile,  J) ; 

GET(fspshipfile) 

END; 

CLOSE(f  spshlpf  lie) ; 

write(at(x,7),'Press  <RETURN>');  readln 
END;  {  fspresiduechecK  } 

SEGMENT  PROCEDURE  fspinquery; 

VAR  i,J,k,num,  entries,  loc  :  integer; 
commoname  :  string  [25]; 
quit  :  boolean; 
commodlist  :  intype; 
ch  :  char: 

twodeci,strl,str2,str3  characters; 
BEGIN  C*  fspinquery  *') 
quit  :=  false, 

REPEAT 

prompt(fspquerymenu,  5,  choice) ; 

CASE  choice  OF 
i  .  BEGIN 

RESET(fsphashfile,  ,#5 :  fsphashfile'); 


write(chr(l2),at(l5,0),  ‘List  of  all  commodities’); 
entries  :=  1;  commodlist[l]  :=  '  j  :=  -1; 

REPEAT 
REPEAT 
j  :=  j  +  i; 

SEEK(fsphashfile,  j); 

GET(fsphashfile) 

UNTIL  (EOF(fsphashflle))  OR  (fsphashflle*.  status  <> 

empty); 

IF  NOT  EOF(fsphashfile) 

THEN  BEGIN 
i  :=  1; 

(*  check  if  this  record's  name  is  already  in 
commodity  array,  if  not  put  it  *) 

WHILE  (i  <  entries)  AND 
(fsphashflle*.  commodity  <>  commodllst[l])  DO 
i  :=  i  +  1; 

IF  i  :=  entries 

(*  not  in  customers  array  so  put  it  in  *) 

THEN  BEGIN 

commodlist[i]  ;  = 

fsphashfile".  commodity; 
entries  :=  entries  +  1 
END; 

END 

UNTIL  EOF(fsphashfile); 

CLOSE(f  sphashf  ile) ;  1  :=  1; 

WHILE  1  <=  entries  -  1  DO 
BEGIN 

IF  validate(commodlist[i3) 

THEN  write(at(x,  i) ,  commodlist  [i] ) ; 
i  :=  i  +  1 
END; 

wrlte(at(55,22),'Press  <RETURN>’);  readln 
END; 

2  BEGIN 
REPEAT 

writetchr(12),at(x,3),  'Commodity  name: '); 
readln  (commoname) 

UNTIL  (commoname  <>  ‘  ')  OR  EOF; 

(*  not  empty  or  terminate  *) 

IF  EOF  THEN  BEGIN  RESET(INPUT);  EXIT(fspinquery)  END; 

RESET(fsphashfile,  *5:fsphashfiie'); 

write(chr ( 12 ) ,  at (15 , 0 ) , ' Contracts  of ' ,  commoname) , 

J  :=  2; 


FOR  i  :=  0  TO  max  DO 
BEGIN 

SEEK  (fsphashf  lie,  i); 

GET(fsphashfile); 

IF  (fsphashfile*.  status  =  occupied) 

AND  (fsphashfile* .  commodity  =  commoname) 
THEN  BEGIN 

wrlte(at(x  J),  fsphashfile*.  number,  * 
fsphashf  ileA .  name); 

J  :=J  +  1 
END; 

IF  J  =  22  (*  full  screen  *) 

THEN  BEGIN 

write(at(55, 22), 'Press  <RETURN>'); 
readln;  write (chr (12);  J  :=  2 
END; 

END; 

write(at(55,22),  'Press  <RETURN>');  readln; 
CLOSE(fsphashfile) 

END; 

3  :  purcontrinfo; 

4  :  fspresiduechecK; 

5  :  quit  :=  true; 

END;  (*  case  *) 

UNTIL  quit 
END; 

SEGMENT  PROCEDURE  fspnew; 

(*  to  add  new  feed  stuff  contract  and  setup  the  data  structure 
accordingly  *) 

VAR  lineno,  j.k.loc,  choice,  addr.i  :  integer; 
goon,  finish,  done,  located  :  boolean; 
temp  :  characters; 
ch  :  char; 

tempdate  :  datetype; 

PROCEDURE  tosconvert(line:  characters;  VAR  tos:tostype); 

CONST  blank  =  '  '; 

VAR  temp  :  tostype; 

i,j,  max,  start  ;  integer; 
item  ;  characters; 

BEGIN 

line  :=  CONCAT(line, 
max  :=  LENGTH(line), 

WITH  temp  DO 


BEGIN 

month  :=  0;  wgt  :=  0;  bal  :  =  0;  unitprice  :=  0 
END; 

i  :=  1;  J  :=  1; 

REPEAT 

WHILE(line[i]  =  blank)  AND  (i  <  max)  DO 
i  :*  i  +  1; 

item  :=  COPY  (line,  start,  1-start); 

CASE  j  OF 

1  :  temp,  month  :=  conint(item); 

2  :  BEGIN 

temp. wgt  :=  conint(item); 
temp,  bal  :=  temp,  wgt 
END; 

3  :  temp,  unitprice  :=  conreal(ltem) 

END,  (*  case  *) 

J  :=  J  +  1 

UNTIL  (J  >  3)  OR  (1  =  max); 
tos  :=  temp 
END;  (*  tosconvert  *) 

PROCEDURE  getfspinfo; 

(*  get  all  the  information  for  the  new  contract  *) 

FUNCTION  pproceed  :  boolean; 

BEGIN 

IF  EOF  THEN  BEGIN  RESET(INPUT);EXIT(fspnew)  END 
ELSE  IF  (lineno  <>  6)  AND  (temp  =  *  ') 

THEN  BEGIN 

pproceed  :=  false; 
lineno  :=  lineno  -  1 
END 

ELSE  IF  (lineno  =  6)  AND  (temp  =  '  ') 

THEN  BEGIN 

pproceed  :=  false; 
k  ;=  k  -  1 
END 

ELSE  pproceed  :=  true 

END, 

PROCEDURE  nextpurinput; 

BEGIN 

WITH  fspcontract  DO 
CASE  lineno  OF 
1,3, 4, 5: 


BEGIN 

write(at(x,  lineno),  lineno:  2, '.  ' , f spnewconmenu [lineno] ) ; 
readln(temp); 

IF  pproceed 
THEN  CASE  lineno  OF 

1  :  number  :=  temp; 

3  :  farmer. name  :=  temp; 

4  :  farmer,  addr  :=  temp; 

5  :  commodity  :=  temp; 

END’  (*  case  *) 

END; 

2  :  BEGIN 

write(at(x,2),‘  2.  ',f spnewconmenu [2]); 
readln(temp); 

IF  pproceed 
THEN  BEGIN 

dateconvert(temp,  contrdate); 

IF  da techeck (contrdate)  <>  ok 
THEN  BEGIN 

write  (at  (3  8, 2),  'Error  in  input,  press 

<RETURN>'); 

readln;write(at(38,2),’  30); 

lineno  :  =  lineno  -  1 

END 

END 

END; 

6  :  BEGIN 

WITH  fspcontract  DO 
BEGIN 

totalship  :=  0; 

write(at(x,9), '  6.  ',f spnewconmenu [6]); 
finish  :=  false;  k  :  =  0; 

REPEAT 
k  :=  k  +  1; 

GOTOXY (x+33, 9+k) ;  readln (temp) ; 
finish  :=  (temp  =  'F')  OR  (temp  =  T); 

IF  (pproceed)  AND  (NOT  finish) 

THEN  BEGIN 

tosconvert(temp,  timeofship  [k] ) ; 

IF  (timeof ship [k]. month  <  1)  OR 
(timeof ship  [k] .  month  >  12) 

THEN  BEGIN 

write(at(x+30, 9+k), 

'Error  in  input,  press  <RETURN>  ), 
readln; 
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write(at(x+30,9+k),’  *: 30);  k  :=  k 
END 

ELSE  totalship  :=  totalship  + 

timeofship[k].wgt 

END; 

UNTIL  (k  =  6)  OR  (finish); 
balofship  :=  totalship; 

IF  k  <  6  THEN  BEGIN 

write  (at  (x+30 , 9+k) , '  ‘ :  30) ; 
timeofship[k].  month  :=  0 
(*  o  is  endofdata  marker  *) 

END 

END 

END; 

END;  (*  case  *) 

END;  (*  nextpurlnput  *) 

PROCEDURE  fspmodify; 

(*  to  modify  the  fspcontract  input  information  *) 

BEGIN 

REPEAT 

REPEAT 

goon  :=  true; 

write(at(55, 22),' Which  line  to  change:’); 
readln(lineno);  write  (at  (55, 22),'  ’:24); 

IF  (lineno  <  1)  OR  (llneno  >  6) 

THEN  BEGIN 

write(at(55,22),chr(7),’No  such  line! Press  <RET>‘); 
readln;  write  (at  (55, 22),  *  25);  goon  :=  false 

END 

UNTIL  goon; 

(*  now  erase  the  line  to  be  changed  *) 

IF  lineno  <=  5 
THEN  BEGIN 

write(at(38,  lineno), '  ' :  40); 

GOTOXY  (38,  lineno) 

END 

ELSE  FOR  j  :  =  1  TO  k  DO 

write(at(43,9+j),’  ‘ :  20); 

(*  no  GOTOXY  here  since  it  is  in  case  6:  *) 
nextpurlnput; 

write(at(55,22), 'OK  now?(y/n)'); 
read(ch); 

UNTIL  (ch  =  'Y')  OR  (ch  =  'y') 

END;  (*  fspmodify  *) 
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BEGIN 

wrlte(chr(l2),  at(l5, 0),  fspnewconmenu  [0]); 
llneno  :=  1; 

REPEAT 

nextpurinput; 
llneno  :=  llneno  +  1 
UNTIL  llneno  >  6; 

fspcontract.nof shipment  :=  0;  fspcontract.  status  :=  occupied; 
wrlte(at(55,22),  ‘Input  OK?(y/n)‘); 
read(ch);  IF  (ch  =  ‘N‘)  OR  (ch  =  ‘n‘)  THEN  fspmodify 
END;  (*  getfsplnfo  *) 

BEGIN  (*  fspnew  *) 

getfsplnfo;  (*  input  all  pertinent  new  purchase  contract  info  *) 
(*  go  through  the  file  and  make  sure  that  the  given  contract 
is  not  already  in  the  file  *) 

RESET  (f  sphashf  lie,  ‘*5:  fsphashfile1); 

REPEAT 

done  :=  true; 
i  :=  -1; 

REPEAT 
1  :■  1  +  1; 

SEEK  (fsphashfile,  l); 

GET(fsphashfile) 

UNTIL  (EOF(fsphashfile))  OR 

(fsphahsfile*.  number  =  fspcontract.  number); 

IF  fsphashfile*. number  =  fspcontract. number 
THEN  REPEAT  (*  error!  same  contract  already  in  table  *) 
prompt  (errorl,  3,  choice); 

CASE  choice  OF 

1  :  BEGIN  CLOSE(fsphashfile);  EXIT(fspnew)  END; 

2  :  BEGIN  CLOSE(fsphashfile);fsplnquery  END; 

3  :  BEGIN 

REPEAT 

write(chr(l2),at(x,3),  ’Contract  number 

(<ctri-c>  to  quit):'); 
readln(fspcontract.  number); 

UNTIL  (fspcontract.  number  <>  ’  ’)  OR  EOF; 
done  :=  false; 

IF  EOF  THEN  BEGIN 

CLOSE(fsphashflle); 

RESET  (INPUT); 

EXIT(fspnew) 
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END;  (*  case  *) 

UNTIL  choice  =  3 

(*  no  error  so  put  into  the  fspfile  and  fsphashfile  *) 

ELSE  BEGIN 

(*  place  the  new  purchase  contract  info  into  the  fspfile; 

place  at  the  first  open  slot  *) 

RESET (fspfile,  ,#5 :  fspfile’); 

(*  put  the  contract  info  into  the  first  open  slot  *) 

Ioc  :=  -1; 

REPEAT 
loc  :=  loc  +  1; 

SEEK  (fspfile,  loc); 

GET(fspfile); 

UNTIL  (fspfile*.  status  =  empty)  OR  (EOF(fspfile)); 

IF  EOF (fspfile) 

THEN  BEGIN 

write(chr(12),at(x,3),'DOOMESDAY!  No  more  space 
to  add  new  contract’); 
write(at(x,4),'Must  use  new  diskette. 

Press  <RETURN>'); 
readln;  CLOSE  (fspfile);  EXIT(fspnew) 

END; 

fspfile* :  =  fspcontract; 

SEEK  (fspfile,  loc); 

PUT(fspfile);  CLOSE(fspfile); 
write(at(0,22),'loc  =  ’,loc); 

(*  find  open  slot  in  fsphashfile  *) 

RESET(fsphashfile); 
i  :=  -1; 

REPEAT 
i  :=  i  +  1; 

SEEK(fsphashfile,  1); 

GET(fsphashfile) 

UNTIL  fsphashfile*.  status  =  empty; 

(*  put  in  the  information  *) 

WITH  fsphashfile*  DO 
BEGIN 

status  :=  occupied; 
number  :=  fspcontract.  number; 
name  :=  fspcontract.  farmer,  name; 
link  .=  loc, 

commodity  :=  fspcontract. commodity 
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APPENDIX  B 

THE  dBASE  III  PLUS  PROGRAMS 


xxxxx 

xxxxx 

xxxxx 

xxxxx 

xxxxx 

xxxxx 


program  HANAOKA 
Original  written  in  Apple  Pascal 
Rewritten  in  dBASE  III  PLUS 
Author  :  To  Chang 
Date  :  June  1987 
Instructor  :  Prof.  Thomas  C.  Wu 


clear  all 
set  talk  off 
set  bell  off 
set  dele  on 
set  exact  on 


store  T.  to  badentry 

do  while  badentry 
clear 

@  10,10  say  1  Password  :  (or  hit  <CR>  to  exit...)' 

9  10,50 

set  escape  off 
set  exact  on 
set  console  off 
accept  to  mpass 
set  console  on 


if  mpass  =  '  ' 
set  escape  on 
set  exact  off 
clear 
return 
endif 


if  mpass  *  HANAOKA' 

$  20,20  say  'Incorrect  password  ...  (hit  <CR>  to  retry)' 
?  chr(7) 
wait  '  ' 
loop 
endif 

store  F.  to  badentry 
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enddo 


clear 
store 
9  02, 
9  03, 
9  04, 
9  05, 
9  06, 
9  08, 
9  10, 
9  12, 
9  18, 

read 


*****  MAIN  MENU  ***** 

‘  ’  to  mchoice 

15  say  ’++++++++++++++++++++++++++++++++++++++++++++' 
15  say  '+  +* 

15  say  '+  ABC  COMPANY  +‘ 

15  asy  '+  +' 

15  say  '++++++++++++++++++++++++++++++++++++++++++++’ 
15  say  '  1.  Sales' 

15  say  *  2.  Purchase' 


15  say 
15  say 
15  say 
15  say 


2.  Purchase' 

3.  Quit' 

Choose  one  function  — >(1,2,3)'; 
get  mchoice  pict  'x' 


store  .T.  to  mcontinue 

do  while  mcontinue 
do  case 

case  mchoice  =  '1‘ 
do  sale 

case  mchoice  =  '2‘ 
do  purchase 
otherwise 

store  .F.  to  mcontinue 
clear 

endcase 

enddo 

close  databases 
quit 

*  <End  of  HANA0KA> 


a 
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•Program  SALE.PRG  -  called  from  HANAOKA 

do  while  .T. 
clear 

store  ’  1  to  mchoice 

0  02,15  say  *++++++++++++++++++++++++++++++++++++++++++++++' 
0  03,15  say  '+  +‘ 

9  04,15  say  *+  ABC  Sale  Information  +' 

0  05,15  say  '+  +* 

0  06,15  say  *++++++++++++++++++++++++++++++++++++++++++++++' 
@  08,15  say  1  1.  New  Sale  Contract  Entry1 

0  10,15  say  1  2.  New  Sale  Shipment  Entry* 

0  12,15  say  1  3.  Sale  Information  Inquery 1 

0  14,15  say  '  4.  Quit1 

0  18,15  say  1  Choose  one  function  — >(1,2,3, 4)’; 

get  mchoice  pict  'x‘ 

read 
do  case 

case  mchoice  =  T 
do  newsale 
case  mchoice  =  '2' 
do  SL_shipinfo 
case  mchoice  =  '3' 
do  s-inquery 
otherwise 
clear 
return 

endcase 

enddo 

*  <End  of  SALE> 
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public  mtotalshlp,  mnofshipmnt,  msnumber 
do  while  .T. 


store 

space(l2) 

to 

msnumber,  mlcnumber 

store 

space(50) 

to 

mcommodity ,  mcustaddr 

store 

space(80) 

to 

mpricebase 

store 

space  (30) 

to 

missuebank,  mdrawbank 

store 

space(l8) 

to 

mmitlno 

store 

space(25) 

to 

mcname 

store 

space(l3) 

to 

mcustphone 

store 

space(8) 

to 

mcontrdate,  mlcexpdate,  mlcshipdate 

store 

t  i 

to 

manswer 

store 

0 

to 

mlcbal,  mwgt,  mbal,  mlcamount 

store 

0 

to 

munitprtce,  mtotalshlp,  mbalofshlp 

store 

0 

to 

mnofshipment 

store 

.T. 

to 

nogood,  notok 

do  while  notok 
do  while  nogood 
set  confirm  on 
set  format  to  contract 
read 

if  msnumber  =  ' 

set  format  to 
set  confirm  off 
store  .F.  to  nogood 
return 

endif 

use  b:s_contract  index  b:s_conindx 
find  &msnumber 
if  found() 

?  chr(7) 

9  04,50  say  'Duplicate  key  !' 

<a  24,05  say  'Replace?  Discard?  Inquery7(R,D,  I)‘; 
get  manswer  pict  'x' 

read 

if  upper(manswer)  =  R' 
store  .F.  to  nogood 
9  24,05  say  ' 

endif 

if  upper(manswer)  =  T 
use 

close  Index 
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r 

do  s_lnquery 
return 

l  endif 

j  if  upper  (manswer)  = 

•D' 

1  clear  all 

I  endif 

H  else 

g  set  format  to 

t  store  .F.  to  nogood 

1  endif 

J  enddo 

l  store  '  ‘  to  manswer 

5  ?  chr(7) 

i  G  24,05  say  'Input  0K?(y/n)'  get  manswer  pict  'x' 

1  read 

!  if  upper  (manswer)  =  'Y' 

v  store  F.  to  notok 

^  endif 

S  enddo 

[j  do  tmship 

< 

\  use 

\  close  index 

use  b:s_contract  index  b:s»conindx  1 

append  blank 

M  replace  snumber 

with  msnumber 

3  replace  cname 

with  mcname 

5  replace  contrdate 

with  mcontrdate 

£  replace  commodity 

with  mcommodity 

n  replace  pricebase 

with  mpricebase 

)  replace  lenumber 

with  mlcnumber 

*  replace  lcexpdate 

with  mlcexpdate 

J  replace  lcshipdate 

with  mlcshipdate 

J  replace  lcbal 

with  mlcbal 

replace  lcamount 

with  micamount 

I  replace  totalship 

with  mtotalship 

[  replace  balofship 

with  mbalofship 

P  replace  issuebank 

with  missuebank 

P  replace  drawbank 

with  mdrawbank 

f  replace  mitino 

with  mmitlno 

1  replace  nofshipmnt 

t 

with  mnofshipmnt 

t 

i 

'.L' 
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US€ 

close  index 
select  3 

use  b:  customer  index  b:custindx 
find  imcname 
If  .NOT.  found() 
append  blank 

replace  cname  with  mcname 

replace  address  with  mcustaddr 

replace  phoneno  with  mcustphone 

endif 

close  databases 
clear  all 
enddo 

*  <  End  of  NEWSALE.PRG  > 
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*  Program  SLINQUERY.PRG 


do  while  .  T. 
clear 
clear  all 

public  mcontrno 
store  0  to  lctr 
store  *  '  to  mchoice 
store  '  ‘  to 

store  ' 


called  from  HANAOKA  or 
or  NEWSALE  or  S-SHIPINFO 


store  '  ‘  to  mcontrno 

store  '  *  to  mcompname 

0  02,15  say  '++++++++++++++++++++++++++++++++++++++++++++++' 
0  03,15  say  '+  +' 

0  04,15  say  '+  SALE  INFORMATION  INQUERY  +' 

9  05, 15  say  '+  +■ 

@  06,15  say  '++++++++++++++++++++++++++++++++++++++++++++++' 
0  08,15  say  '  1.  List  Customer' 

0  10,15  say  ‘  2.  List  All  Contracts  of  One  Customer' 

0  12,15  say  '  3.  List  One  Contract  Info.' 

0  14,15  say  '  4.  Quit' 

0  22,15  say  '  Choose  one  function  — >(1,2,3, 4)'; 

get  mchoice  pict  'x‘ 

read 


do  case 

case  mchoice  =  T 
clear 

0  00,10  say  '  +++++++  Customer  List  +++++++' 

use  b.  customer  index  b.custindx 
do  while  not.  eof() 
store  lctr+1  to  lctr 
if  lctr  >=  19 
store  0  to  lctr 

wait  'More  list  on  next  page. . . '  to  memvar 
clear 
endif 

0  lctr,  02  say  'Name:  ’ 

0  lctr,  08  say  cname 
store  lctr+1  to  lctr 
0  lctr, 02  say  ’Address:  ‘ 

0  lctr,  11  say  address 

store  lctr+1  to  lctr 

0  lctr, 02  say  'Phone  number:  ' 

0  lctr,  16  say  phoneno 


store  lctr+1  to  lctr 

@  lctr,  10  say  '=================================- 

skip 

enddo 

wait 

use 

close  index 
case  mchoice  =  '2' 
clear 

9  02,1  say  ’Company  Name  =  ’  get  mcompname; 
pict  xxxxxxxxxxxx' 

read 

9  04,15  say  'Contract  with  ' 

9  04,30  say  mcompname 

use  b.  SL_contract  index  b:s_conindx 

disp  all  cname,  commodity  for  cname  =  mcompname  off 

wait 

use 

close  index 
case  mchoice  =  '3' 
clear 

9  12,20  say  'Contract  Number:'  get  mcontrno; 
pict  'xxxxxxxxxxxx' 

read 

9  12,37  say  mcontrno 
select  2 

use  b:s_contra  index  b:s_conindx 

find  &mcontrno 
if  found() 
use 

close  index 
do  salelist 
9  23,25  say  " 

accept  'Need  a  printout? (y/n)'  to  manswer 
if  upper(manswer)  =  'Y' 

<a  23,00  say  'Turn  on  the  printer,' 
wait 

set  device  to  print 
do  salelist 

set  device  to  screen 

endlf 

store  '  1  to  manswer 

else 

9  20,20  say  'No  such  contract  in  the  file!!' 


*  Program  SLSHIPINFO 


called  from  SALE.PRG 


clear 

store  '  '  to  manswer 


do  while  T. 

store 

space(l5) 

to  minvoiceno 

store 

space  (25) 

to  mname,  morigin,  mdest 

store 

space(8) 

to  metd,  minvdate 

store 

space(l2) 

to  msnumber,  mcnumber 

store 

0 

to  mtotalbales,  mtotainet 

store 

0 

to  mnofcontner,  mbales,  mnet 

set  confirm  on 

set  format  to  sshipment 

read 

if  minvoiceno  =  ’ 
set  format  to 
set  confirm  off 
use 

close  index 
return 

endif 

9  24,20  say  'Input  OK?(y/n)‘  get  manswer  pict  'x' 
read 

if  upper  (manswer)  =  'Y' 

use  b:contner  index  bicontnrdx 
append  blank 

replace  cnumber  with  msnumber; 

invoiceno  with  minvoiceno 


do  scompute 

replace  bales 
net 


with  mbales; 
with  mnet 


store  mtotalbales  +  mbales 
store  mtotainet  +  mnet 
store  mnofcontner  +  1 


to  mtotalbales 
to  mtotainet 
to  mnofcontner 


store  .F.  to  mcontinue 

@  24,15  say  'More  container? (y/n) — >'  get  manswer  pict  'x' 
read 

if  upper(manswer)  =  'Y' 

store  .T.  to  mcontinue 


9  24,15  say  ' 

endif 

do  while  mcontinue 

set  format  to  contfmt 
read 

if  mcnumber  =  ' 
set  format  to 
set  confirm  off 
use 

close  index 

store  .F.  to  mcontinue 
else 

@  24,15  say  'Input  OK?(y/n) — >’  get  manswer; 
pict  'x‘ 

if  upper  (manswer)  =  'Y' 

9  24,15  say  * 
appnd  blank 

replace  cnumber  with  mcnumber; 

invoiceno  with  minvoiceno 

do  scompute 

replace  bales  with  mbales; 

net  with  mnet 

store  mtotalbales  +  mbales  to  mtotalbales 
store  mtotalnet  +  mnet  to  mtotalnet 
store  mnofcontner  +  1  to  mnof coroner 

$  24,15  say  ‘More  containers? (y/n) — >*  get; 
manswer  pict  'x‘ 

read 

$  24,15  say  ' 
if  upper  (manswer)  =  'Y' 
store  .T.  to  mcontinue 
else 

store  .  F.  to  mcontinue 

endif 

endif 

endif 

enddo 

use  b:si_shipmt  index  b:sshipdx 

append  blank 


replace  Involceno 
name 
origin 
dest 
replace  etd 

invoicedat 
replace  totalbales 
totalnet 
nofcontner 
snumber 
use 

close  Index 
endlf 
enddo 

*  <End  of  SLSHIPINFO> 

*  Program  SALELIST.PRG  - 


with  mlnvoiceno; 
with  mname; 
with  morigln; 
with  mdest 
with  metd; 
with  minvdate 
with  mtotalbales; 
with  mtotalnet; 
with  mnofcontner; 
with  msnumbr 


called  from  SL1NQUERY .  PRG 


clear 

set  relation  to  cname  into  customer 

9  01,10  say  '=====  Feed  Stuff  Sale  Contract  Information  =====' 
9  02,02  say  ‘Sale  Number:' 

9  02, 19  say  snumber 
9  03,02  say  'Contract  Date:' 

9  03,19  say  contrdate 
9  04,02  say  'Customer  Name:' 

9  04, 19  say  cname 
9  05,02  say  'Customer  Address:' 

9  05,19  say  address 
9  06,02  say  'Commodity:' 

9  06, 19  say  commodity 
9  07,02  say  'Price  Base:' 

9  07,19  say  prlcebase 

9  08,02  say  'Time  of  Shipment  :  Months  Quantity 

9  08,46  say  '  Balance  Unitprice' 

store  9  to  minctr 

set  relation  to  snumber  into  tmofship 


do  while  .not.  eof(tmofship)  .and.  snumber 
9  minctr,  32  say  month 
9  minctr,  39  say  wgt 
9  minctr,  47  say  bal 
9  minctr,  57  say  unitprice 


=  mcontrno 
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store  mlnctr  +  1  to  mlnctr 
skip 
enddo 

P  mlnctr +2, 02  say  'Total  Shipment:' 

P  mlnctr +2, 22  say  totalship 
•  mlnctr +3, 02  say  'Balance  of  Shipment: 
P  mlnctr +3, 22  say  balofship 
P  mlnctr+4, 02  say  'L/C  number:' 

P  mlnctr+4, 22  say  lcnumber 
P  mlnctr +5, 02  say  'L/C  expire  date:' 

P  mlnctr +5, 22  say  lcexpdate 
$  mlnctr +6, 02  say  'L/c  shipment  date:' 

P  mlnctr +6, 22  say  lcshipdate 
P  mlnctr+7,02  say  'L/C  amount:' 

0  mlnctr +7, 22  say  lcamount 
P  mlnctr+8,02  say  'L/C  balance:' 

P  mlnctr +8, 22  say  lcbal 
P  mlnctr +9, 02  say  'Issue  Bank:' 

P  mlnctr +9, 22  say  issuebank 
P  mlnctr+10,02  say  'Draw  Bank:' 

P  mlnctr+10,22  say  drawbank 
P  mlnctr+11,02  say  'Miti  number:' 

P  mlnctr+11,22  say  mltlno 
P  mlnctr+12,02  say  •*  of  shipment  made: 
P  mlnctr+12, 22  say  nofshipment 

return 


<End  of  SALELIST.  PRG> 


*  Program  SCOMPUTE.PRG 


called  from  S_SHIPINFO.PRG 


public  mnet 
public  mrate 

store  0  to  mrate 

select  2 

use  b:  tmofship  index  b:tmshipdx 
set  relation  to  snumber  into  tmofship 

do  while  .not.  eof (tmofship)  .and.  snumber  =  msnumber 
if  month  =  substr(invoicedate,  4, 5) 

$  12,15  say  ‘Rate  =  ’ 

@  12,20  say  unitprice 

9  20,10  say  'Compute  the  price  with  the  above  rate?(y/n)', 
get  manswer  pict  'x‘ 

read 

if  upper(manswer)  =  'N‘ 
clear 

@  12,15  say  ’Rate  =  '  get  mrate  pict  ’9999999999999.99’ 
else 

store  unitprice  to  mrate 
endlf 

store  totalnet/2000.0  to  mshiintons 
store  bal-mshintons  to  bal 

set  relation  to  snumber  into  SL-contra 

store  balofship-mshintons  to  balofship 
store  lcbal-mshlntons*mrate  to  lcbal 
endlf 
skip 
enddo 
use 

close  index 
return 

*  <End  of  3C0MPUTE.  PRG> 
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Program  SALEPRT.PRG 


called  from  SLINQUERY.PRG 


X 


clear 

store  space  (25)  to  mcname 
select  2 

use  b:s_con tract  index  b:s_conindx 
find  &mcontrno 

9  00,10  say  '=====  Feed  Stuff  Sale  Contract  Information  =====• 
9  02,02  say  'Sale  Number:' 

9  02, 19  say  snumber 
9  03,02  say  ‘Contract  Date:' 

9  03,19  say  contrdate 
9  04,02  say  'Customer  Name:1 
9  04, 19  say  cname 
store  cname  to  mcname 
select  3 

use  b: customer  index  b.custindx 
find  imcname 

9  05,02  say  ‘Customer  Address:' 

9  05, 19  say  address 
select  2 

9  06,02  say  'Commodity:' 

9  06, 19  say  commodity 
9  07,02  say  'Price  Base:' 

9  07, 19  say  pricebase 

9  08,02  say  ‘Time  of  Shipment  Months  Quantity  ' 

9  08,46  say  '  Balance  Unitprice’ 

store  9  to  mlnctr 
select  4 

use  b:tmofship  index  b:tmshipdx 
do  while  .not.  eof() 

if  snumber  =  mcontrno 
9  mlnctr,  32  say  month 
9  mlnctr,  39  say  wgt 
9  mlnctr,  47  say  bal 
9  mlnctr,  57  say  unitprice 
store  minctr+l  to  mlnctr 
endif 
skip 
enddo 
select  2 

9  mlnctr+2,02  say  'Total  shipment:' 

9  mlnctr+2,22  say  totaiship 
9  mlnctr+3,02  say  'Balance  of  ship:' 
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®  mlnctr+3,22  say  balofship 
@  mlnctr+4,02  say  'L/C  number:' 

@  mlnctr+4,22  say  lcnumber 
@  mlnctr+5,02  say  ‘L/C  expire  date:' 

9  mlnctr+5,22  say  lcexpdate 
@  mlnctr+6,02  say  'L/C  shipment  date:' 

9  mlnctr+6,22  say  lcshipdate 
«►  mlnctr+7,02  say  ‘L/C  amount:' 

@  mlnctr+7,22  say  lcamount 
@  mine tr +8, 02  say  'L/C  balance:' 

@  mlnctr+8,22  say  lcbal 
@  mlnctr+9,02  say  'Issue  Bank:' 

@  mlnctr+9,22  say  issuebank 
@  mlnctr+10,02  say  'Draw  Bank:' 

@  mlnctr+10,22  say  drawbank 
@  mlnctr+11,02  say  'Mitl  number:' 

@  mlnctr+11,22  say  mitino 
@  mlnctr+12,02  say  ,#  of  shipment  made: 
@  mlnctr+12, 22  say  nofshipment 
eject 
return 

<  End  of  SALEPRT.PRG  > 


* 


X 


Program  SALELIST.PRG 


called  from  SLINQUERY.  PRG 


clear 

store  space(25)  to  mcname 
select  2 

use  b:s_contract  index  b:s_conindx 
find  &mcontrno 

@  01,10  say  ’=====  Feed  Stuff  Sale  Contract  Information  =====' 
@  02,02  say  'Sale  Number:' 

@  02, 19  say  snumber 
@  03,02  say  'Contract  Date:' 

@  03, 19  say  contrdate 
@  04,02  say  'Customer  Name:' 

@  04, 19  say  cname 
store  cname  to  mcname 
select  3 

use  b:  customer  index  b:custindx 
find  imcname 

@  05,02  say  'Customer  Address:' 

@  05,19  say  address 
select  2 

@  06,02  say  'Commodity:' 

@  06,19  say  commodity 
@  07,02  say  'Price  Base:' 

@07,19  say  pricebase 

@  08,02  say  'Time  of  Shipment  Months  Quantity  ' 

@  08,46  say  '  Balance  Unitprice' 

store  9  to  mlnctr 
select  4 

use  b:tmofship  index  b:tmshipdx 
do  while  not.  eof() 

If  snumber  =  mcontrno 
@  mlnctr,  32  say  month 
@  mlnctr,  39  say  wgt 
@  mlnctr,  47  say  bai 
@  minctr,57  say  unitprice 
store  minctr+1  to  mlnctr 
endif 
skip 
enddo 
select  2 

if  mlnctr  >=  12 

wait  'More  informations  on  next  page...'  to  memvar 


store  0  to  mlnctr 
clear 

endif 

9  mlnctr +2, 02  say  'Total  shipment:' 

9  mlnctr +2, 22  say  totalship 
9  mlnctr +3, 02  say  'Balance  of  ship:' 

9  mlnctr+3,22  say  balofship 
9  mlnctr +4, 02  say  'L/C  number:' 

9  mlnctr +4, 22  say  lcnumber 
9  mlnctr +5, 02  say  'L/C  expire  date:' 

9  mlnctr +5, 22  say  lcexpdate 
9  mlnctr +6, 02  say  ‘L/C  shipment  date:' 

9  min ctr+6,22  say  lcshipdate 
9  mlnctr+7,02  say  'L/C  amount:' 

9  mlnctr+7,22  say  lcamount 
9  mlnctr +8, 02  say  'L/C  balance:' 

9  mlnctr +8, 22  say  lcbal 
9  mlnctr +9, 02  say  'Issue  Bank:' 

9  mlnctr+9,22  say  issuebank 
9  mlnctr+10,02  say  'Draw  Bank:' 

mlnctr+10,22  say  drawbank 
@  mlnctr+11,02  say  'Miti  number:' 

9  mlnctr+11,22  say  mitino 
9  mlnctr+12,02  say  of  shipment  made: 
9  mlnctr +12, 22  say  nofshipment 
return 

*  <  End  of  SALEPRT.PRG  > 


*  Program  CONTRACT.  FMT - called  from  NEWSALE.PRG 

@  01,05  say  date() 

@  01,15  say  'NEW  SALE  CONTRACT  DATA  ENTRY  SCREEN' 

$  02,15  say  '=====================================' 

@  04,05  say  'Sale  Number:  ‘  get  msnumber  pict; 

xxxxxxxxxxxx' 

@  05,05  say  'Customer  Name:  '  get  mcname  plct; 

'  xxxxxxxxxxxxxxxxxxxxxxxxx ' 

@  06,05  say  'Customer  Address:  '  get  mcustaddr  pict; 

'  xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ' 

@  07,05  say  'Customer  Phone#:  '  get  mphoneno  pict, 

'(xxx)xxx-xxxx' 

@  08,05  say  'Contract  Date:  '  get  mcontrdate  pict; 

'xx/xx/xx' 

@  09,05  say  'Commodity:  '  get  mcommodlty  pict; 

'  xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ' 

@  10,05  say  'Price  Base:  ‘  get  mpricebase  pict; 

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

XX' 

@  12,05  say  'L/C  Number:  '  get  mlcnumber  pict; 

xxxxxxxxxxxx* 

@  13,05  say  'L/C  Exp.  Date:  *  get  mlcexpdate  pict; 

'xx/xx/xx' 

<§>  14,05  say  'L/C  Ship  Date:  '  get  mlcshipdate  pict; 

'xx/xx/xx' 

£  15,05  say  'L/C  Bale:  '  get  mlcbal  pict; 

'9999999999999.99' 

@  16,05  say  'L/C  Amount:  '  get  mlcamount  pict; 

'9999999999999  99' 

@  17,05  say  'Issue  Bank:  '  get  missuebank  pict, 

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx' 

@  18,05  say  'Draw  Bank:  '  get  mdrawbank  pict; 

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx' 

@  19,05  say  'Miti  Number:  '  get  mmitino  pict; 

xxxxxxxxxxxxxxxxxx' 

a  23,05  say  ' — Leave  all  fields  blank,  and  RETURN  to  exit — ' 

‘  <  End  or  CONTRACT  FMT  > 
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*  Program  SSHIPMENT.  FMT - called  from  S_SHIPIN.PRG 

@  02,01  say  date() 

@02,15  say  'NEW  SALE  SHIPMENT  DATA  ENTRY  SCREEN' 

@  03,15  say  '=====================================' 

@  06,05  say  ‘Sale  Number:  1  get  msnumber  pict; 

‘xxxxxxxxxxxx’ 

@  07,05  say  'Customer  Name:  '  get  mname  pict; 

'xxxxxxxxxxxxxxxxxxxxxxxxx' 

@  08,05  say  'Origin:  '  get  morigin  pict, 

'xxxxxxxxxxxxxxxxxxxxxxxxx' 

@  09,05  say  'Destination:  '  get  mdest  pict; 

'xxxxxxxxxxxxxxxxxxxxxxxxx' 

@  10,05  say  'Estimate  Date:  '  get  metd  pict  'xx/xx/xx' 

@  11,05  say  ‘Invoice  Date:  '  get  minvdate  pict  'xx/xx/xx' 

@  12,05  say  '============  Container  Data  Entry  =========== 

@  13,05  say  'Invoice  Number:  '  get  minvoiceno  pict, 

xxxxxxxxxxxxxxx' 

@  14,05  say  ‘Container  Number:  ’  get  mcnumber  pict; 

'xxxxxxxxxxxx' 

@  15,05  say  'Bales:  '  get  mbales  pict, 

'9999999999999.99' 

@  16,05  say  'Net:  '  get  mnet  pict; 

'9999999999999.99' 

@  23,05  say  ' — Leave  all  fields  blank,  and  RETURN  to  exit—' 

*  <  End  of  SSHIPMENT.  FMT  > 


*  Program  TOFSHIP.FMT - called  from  NEWSALE.PRG 

9  01,05  say  date() 

9  01, 15  say  'TIME  OF  SHIPMENT  DATA  ENTRY  SCREEN' 

9  02,15  say  ’===================================' 

9  04,05  say  'Month:  '  get  mmonth  pict  99' 

9  05,05  say  'Weight:  '  get  mwgt  plct  '9999999999999.99' 

9  06,05  say  'Bales:  '  get  mbal  plct  '9999999999999.99' 

9  07,05  say  'Unit  Price:  '  get  munitprlce  pict  '9999999999999.99' 

9  23,05  say  ' — Leave  all  fields  blank,  and  RETURN  to  exit — ' 

*  <  End  of  TOFSHIP.FMT  > 


*  Program  CONTFMT.FMT - called  from  S_SHIPIN.PRG 

9  02,01  say  dateQ 

9  02,15  say  '  MORE  CONTAINER  DATA  ENTRY  SCREEN' 

9  03,15  say  '  ================================== 

9  06,05  say  'Container  Number:  '  get  mcnumber  pict, 

xxxxxxxxxxxx' 

9  07,05  say  'Invoice  Number:  '  get  minvoiceno  pict; 

'  xxxxxxxxxxxxxxx ' 

9  08,05  say  'Bales:  '  get  mbales  pict; 

'9999999999999.99* 

9  09,05  say  'Net:  '  get  mnet  pict; 

'9999999999999.99' 

9  23,05  say  ' — Leave  all  fields  blank,  and  RETURN  to  exit — ' 

*  <  End  of  CONTFMT.FMT  > 


*  Program  NEWPURCH.PRG - called  from  PURCHASE. PRG 


public  mtotalship,  mnofshipmnt,  mpnumber 


do  while  .T. 
store 

space(l2) 

to  mpnumber 

store 

space(25) 

to  mfname 

store 

space(50) 

to  mcommodity,  maddress 

store 

space(l3) 

to  mphoneno 

store 

space  (8) 

to  mcontrdate 

store 

0 

to  mtotalship 

store 

0 

to  mbalofship 

store 

0 

to  mnofshipmnt 

store 

.T. 

to  nogood,  notok 

store 

i  i 

to  manswer 

do  while  notok 
do  while  nogood 
set  confirm  on 
set  format  to  contra_p 
read 

if  mpnumber  =  ' 
set  format  to 
set  confirm  off 
use 

close  index 
return 
endif 

use  b:p_contract  index  b:p_conindx 
find  &mpnumber 
if  found  () 

?  chr(7) 

@  06,50  say  'Duplicate  key!!' 

@  24,10  say  'Replace?  Discard?  Inquery? (R,D,1) — >'; 
get  manswer  pict  'x' 

read 

if  upper  (manswer)  =  'R' 
store  F.  to  nogood 
@  24.10  say  ' 
endif 

if  upper  (manswer)  =  T 
use 

close  index 
do  p_inquer 
return 
endif 


else 

store  .F.  to  nogood 
set  format  to 
endif 
enddo 

store  '  '  to  manswer 

@  24,15  say  'Input  OK?(Y/N) — >'  get  manswer  pict  'x' 
read 

If  upper  (manswer)  =  'Y' 
store  .F.  to  notok 
else 

store  .T.  to  nogood 

endif 

enddo 

do  tmship 
use 

close  index 

use  b:p_contract  index  b:p_conindx 
append  blank 

replace  pnumber  with  mpnumber 

replace  fname  with  mfname 

replace  contrdate  with  mcontrdate 

replace  commodity  with  mcommodlty 

replace  totalship  with  mtotalship 

replace  balofship  with  mbalofship 

replace  nofshipment  with  mnofshipmnt 

use 

close  index 

use  b: farmer  index  b:farmerdx 
find  &mfname 
if  .NOT.  found() 
append  blank 
replace  fname 
replace  address 
replace  phoneno 
endif 
use 

close  index 
enddo 

*  <  End  of  NEWPURCH.  PRG  > 


with  mfname 
with  maddress 
with  mphoneno 


called  from  PURCHASE.  PRG 


*  Program  P-SHIPIN.PRG 
clear 

store  .1.  to  nogood 
public  mshipno,  mpnumber,  mcost,  mtotalbales,  mtotalnet 
public  mtruckcost,  mcompute,  mnet,  mcutpntwgt,  mrateacut 
public  mratebcut,  mcost,  mbales 
do  while  .T. 
clear 


store 

space(l2) 

to  mshipno,  mpnumber 

store 

space  (12) 

to  mwgtticket,  mcontrno 

store 

space  (8) 

to  mmthday 

store 

0 

to  mbales,  mnoftruck 

store 

0 

to  mnet,  mcost,  mratebcut 

store 

0 

to  mrateacut 

store 

0 

to  mtotalbales,  mshipintons 

store 

0 

to  mtotalnet,  mcutpntwgt 

store 

0 

to  inpayment,  mtruckcost 

store 

1  t 

to  mcompute,  manswer 

@  12,30  say  " 

accept  1  Contract  number:'  to  mcontrno 

if  mcontrno  =  ' 
return 

endif 
select  2 

use  b:p_contract  index  b:p_conindx 
find  &mcontrno 
if  found  () 
clear 

set  confirm  on 
do  while  nogood 
set  format  to  pshipin 
read 

if  mpshipno  =  ' 
set  format  to 
set  confirm  off 
return 
endif 

@  23,15  say  " 

accept  '  Input  0K?(Y/N) — >’  to  manswer 

if  upper(manswer)  =  'Y' 
store  1  '  to  manswer 
§>  24,15  say  ' 
store  .F.  to  nogood 


do  pcompute 

use  b:  truck  index  b:truckndx 
append  blank 
replace  pshipno 
replace  pnumber 
replace  mthday 
store  space(8) 
replace  wgtticketno 
store  space(l2) 
replace  bales 

store  mtotalbales+mbales 
store  0 
replace  net 

store  mtotalnet+mnet 
store  0 
replace  cost 

store  mtruckcost+mcost 
store  0 
use 

close  index 
@  23,15  say  " 

accept  '  More  trucks?  (Y/N) — >'  to  manswer 

if  upper  (manswer)  =  'Y' 
do  truckin 

endif 

endif 

enddo 

use 

close  index 

store  mtotalnet/2000.0  to  mshipintons 
use  bitofship  index  b:tshipndx 
do  while  .NOT.  eof() 

if  pnumber=mcontrno 

if  month  =  substr  (mthday,  1,2) 
store  bal-mshlpintons  to  bal 
store  mshipintons*unitprice  to  inpayment 
endif 
endif 
skip 
enddo 
use 

close  index 

use  b:p_contract  index  b:p_conmdx 
do  while  .NOT.  eof() 


with  mpshipno 
with  mcontrno 
with  mmthday 
to  mmthday 
with  mwgtticket 
to  mwgtticket 
with  mbales 
to  mtotalbales 
to  mbales 
with  mnet 
to  mtotalnet 
to  mnet 
with  mcost 
to  mtruckcost 
to  mcost 


if  pnumber  =  mcontrno 

store  balofship-mshipintons  to  balofship 
endif 
skip 
enddo 
use 

close  Index 

use  b:p_shipment  index  b:pshipndx 
append  blank 

replace  pshipno 
replace  pnumber 
replace  noftruck 
replace  totalbales 
replace  totalnet 
replace  payment 
replace  truckcost 
use 

close  index 
e 

clear 
?  chr(7) 

@  12,25  say  'No  such  contract  in  the  file  !!' 

@  24, 15 
wait 
dif 
ddo 

<  End  of  P_SHIPIN .  PRG  > 


with  mpshipno 
with  mcontrno 
with  mnof truck 
with  mtotalbales 
with  mtotalnet 
with  mpayment 
with  mtruckcost 


*  Program  TRUCKIN.PRG - called  from  P_SHIPIN.PRG 

use 

close  index 

use  b:  truck  index  b:truckndx 
store  .T.  to  mmore 
do  while  mmore 
clear 

store  '  *  to  manswer 
set  confirm  on 
set  format  to  truckfmt 
read 

if  mwgtticket  =  ' 
set  format  to 
set  confirm  off 
use 

close  index 
return 
endif 

<§>  23,15  say  " 

accept  '  Input  OK?(Y/N) — >'  to  manswer 

if  upper  (manswer)  =  'Y‘ 
store  '  '  to  manswer 
append  blank 
replace  pshipno 
replace  pnumber 
replace  mthday 
replace  wgtticketno 
repalce  bales 
replace  net 

do  pcompute 

replace  cost  with  mcost 

store  mtotalbales+mbales  to  mtotalbales 
store  0  to  mbales 

store  mtotainet+mnet  to  mtotalnet 
store  0  to  mnet 

store  mnoftruck+1  to  mnoftruck 

store  mtruckcost+mcost  to  mtruckcost 

fa  24, 15  say  ’ 

23,15  say  " 

accept  '  More  trucks? (Y/N) — >'  to  manswer 


with  mpshipno 
with  mpnumber 
with  mmthday 
with  mwgtticket 
with  mbales 
with  mnet 


'UUUUUUUUUUUU  W.WV  *V^  V  '^niLwK.wK^'Ki^lLw'lLT' 


l  if  upper(manswer)  =  ‘N* 

•  store  .F.  to  mmore 

@  24,15  say  1 
endif 

store  1  ‘  to  manswer 
endif 
enddo 
use 

close  Index 


*  Program  P_.INQUER.PRG - called  from  HANAOKA.PRG  or 

*  from  NEWPURCH .  PRG  or 

*  from  P_SH1PIN.PRG 

public  mcontrno 
do  while  .T. 

clear  store  '  '  to  mchoice,  manswer 

store  ‘  '  to  mcommoname 

store  '  *  to  mcontrno,  mshlpno 

G  02,15  say  1 ===========================”================' 

@  03,15  say  '=  =' 

@  04,15  say  '=  Purchase  Information  Inquery  =' 

@  05,15  say  '=  =' 

@  06,15  say  '=============================================' 

@  08,15  say  ’  1.  List  all  commodities' 

@  10,15  say  '  2.  List  all  contract  of  one  farmer' 

$  12,15  say  ‘  3.  List  one  purchase  contract  info.' 

@  14,15  say  '  4.  Quit* 

@  20,15  say  '  Choose  one  function  — >(1,2,3, 4)'  get, 

mchoice  pict  'x' 

read 
do  case 

case  mchoice  =  T 
clear 

€>  02,15  say  '====  List  of  all  commodities  ====’ 

use  b:pi_contract  index  b:p_conindx 

display  all  commodity  off 

wait 

use 

close  index 
case  mchoice  =  '2' 
clear 

@  02,15  say  “Farmer’s  name:”  get  mcommoname  pict; 
'xxxxxxxxxxxxxxxxxxxxxxxxx' 

read 

@  03,15  say  ’Contract  with  ’ 

@  03,32  say  mcommoname 

use  b:p_contract  index  b:p_conindx 

display  all  pnumber,  commodity  for  fname=mcommoname 
off 
wait 
use 

close  index 


case  mchoice  =  '3' 
clear 

£  02,15  say  'Contract  Number:'  get  mcontrno  pict; 


if  mcontrno  =  ' 
return 
endlf 

use  b:p_contract  index  b:p_conindx 
find  &mcontrno 
if  found  () 
use 

close  index 
do  purlist 

@  24,15  say  'Need  a  printout? (Y/N) — >'  get  manswer; 
pict  'x' 

read 

if  upper(manswer)  =  'Y' 

@  24, 15  say  ‘Turn  on  the  printer, ' 
wait 

set  device  to  print 
do  purlist 

set  device  to  screen 
endif 

store  ’  '  to  manswer 
use 

close  index 
clear 

@  12,15  say  'See  all  shipments  in  sequence? (Y/N)’; 
get  manswer  pict  'x' 

read 

if  upper  (manswer)  =  ’Y1 
do  pshlist 

@  24,15  say  'Need  a  printout?(Y/N)'  get  manswer; 
pict  'x' 

read 

if  upper  (manswer)  =  'Y' 
set  device  to  print 
do  pshlist 

set  device  to  screen 

endif 

endif 

store  '  '  to  manswer 
else 


@  15,20  say  'No  such  contract  in  the  file!! 


close  Index 
case  mcholce  =  '4' 
return 
endcase 
Ido 

<  End  of  P_INQUER.PRG 


*  Program  TMSHIP.PRG 

- called  from  NEWPURCH.PRG 

clear 

store  space(2) 

to  mmonth 

store  0 

to  mwgt,  mbal,  munitprice 

store  ' 

to  manswer 

store  .T. 

to  mcontinue 

use  b:tofship  Index  b:tshipndx 


do  while  mcontinue 
set  confirm  on 
set  format  to  tofship 
read 

if  mmonth  =  '  ' 
set  format  to 
use 

close  index 
return 

else 

?  chr(7) 

@  21,15  say  " 

accept  'Input  OK?(Y/N) — >'  to  manswer 
if  upper  (manswer)  =  ’Y’ 
append  blank 

replace  month  with  mmonth 

store  ’  1  to  mmonth 

replace  pnumber  with  mpnumber 

replace  wgt  with  mwgt 

replace  bal  with  mbal 


store 

0 

to 

mbal 

replace  unitprice 

with  munitprice 

store 

0 

to 

munitprice 

store 

1  1 

to 

manswer 

store 

mtotalship+mwgt 

to 

mtotalship 

store 

0 

to 

mwgt 

store 

mnofshipmnt+l 

to 

mnofshipmnt 

endif 

endif 

enddo 

*  <  End  of  TMSHIP.PRG  > 


*  program  PURL1ST.PRG - called  from  P-INQUER.PRG 

clear 

store  space(25)  to  mfname 
store  '  '  to  mlnctr 

select  2 

use  b:p_contract  index  b:p_conindx 
find  imcontrno 

9  01,02  say  '===  Feed  Stuff  Purchase  Contract  Information  = 
9  02,02  say  ’Purchase  number:’ 

9  02,21  say  pnumber 
9  03,02  say  ’Contract  date:’ 

9  03,21  say  contrdate 
9  04,02  say  ’Farmer  name:’ 

9  04,21  say  fname 
store  fname  to  mfname 
select  3 

use  b:  farmer  index  b:farmerdx 
find  &mfname 
9  05,02  say  ’Address:’ 

9  05,21  say  address 
select  2 

9  06,02  say  ’Commodity:’ 

9  06,21  say  commodity 

9  07,02  say  ’Time  of  shipment:  Month  Quantity  Balance 

Unitprice’ 

store  8  to  mlnctr 

select  4 

use  b:tofship  index  b:tshipndx 
do  while  not.  eof() 

if  pnumber  =  mcontrno 
9  mmctr,49  say  unitprice 
9  mlnctr,  35  say  bal 
9  mlnctr,  22  say  wgt 
9  mlnctr,  20  say  month 
store  mlnctr +1  to  mlnctr 
endif 
skip 
enddo 
select  2 

9  mlnctr+2,02  say  ’Total  Shipment:’ 

9  mlnctr +2, 21  say  totalship 
9  mlnctr+3,02  say  ’Balance  of  shipment:’ 

9  mlnctr+3,21  say  baiofship 
9  mlnctr+4,02  say  of  shipments  made:’ 


0  mlnctr +4, 21  say  nofshlpment 

eject 

use 

close  index 
return 

*  <  End  of  PURLIST.PRG  > 


*  Program  PSHLIST.PRG - calle 

clear 

store  0  to  mlnctr 

store  space(l2)  to  mshlpno 

select  2 

use  b:p_shipment  index  b:pshipndx 
select  3 

use  b:  truck  index  b:truckndx 
select  2 

store  .T.  to  notdone 
do  while  .not.  eof()  .and.  notdone 
if  pnumber  =  mcontrno 

9  01,02  say  'Shipment  No:' 

9  01,21  say  pshipno 
store  .F.  to  notdone 
endif 
skip 
enddo 

store  pshipno  to  mpshipno 
0  02,02  say  'Date  Wgt  tkt* 
store  3  to  mlnctr 
select  3 

do  while  .not.  eof() 

if  pnumber  =  mcontrno 
@  mlnctr,  01  say  mthday 
0  mlnctr,  09  say  wgtticketno 
0  mlnctr,  21  say  bales 
0  mlnctr,  40  say  net 
@  mlnctr,  55  say  cost 
store  mlnctr+1  to  mlnctr 
endif 
skip 
enddo 


called  from  P.INQUER.PRG 


Bales 


Netwgt 


Cost' 


select  2 

@  mlnctr-H,  02  say  'Total  Bales:' 
@  mlnctr+1,21  say  totlabales 
®  mlnctr+2,02  say  Total  Net:' 

@  mlnctr+2,21  say  totalnet 
@  minctr+3,02  say  'Payment:' 

@  mlnctr+3,21  say  payment 
@  mlnctr+4,02  say  'Truck  Cost:' 
@  mlnctr+4,21  say  truckcost 
eject 
use 

close  index 
return 

*  <  End  of  PSHLIST.PRG  > 
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*  Program  PCOMPUTE.PRG - called  from  P_SHIP1N.PRG 

if  upper (mcompute)  =  'S’ 

if  (mnet/2000.0)  <  mcutpntwgt 

store  (mnet/2000.0)*mratebcut  to  mcost 

else 

store  (mnet/2000.0)*mrateacut  to  mcost 
endlf 
else 

if  mbales  <  mcutpntwgt 

store  mratebcut  to  mcost 
else 

store  (mbales/mcutpntwgt)  *mrateacut  to  mcost 
endif 
endlf 
return 

*  <  End  of  PCOMPUTE.PRG  > 


*  program  CONTRA-P.FMT - called  from  NEWPURCH.PRG 

9  02,01  say  dateQ 

9  02,15  say  'NEW  PURCHASE  CONTRACT  DATA  ENTRY  SCREEN’ 

9  03,15  say  '=========================================' 

9  06,05  say  'Purchase  Number:'  get  mpnumber  pict; 

'xxxxxxxxxxxx* 

9  07,05  say  'Farmer  name:  '  get  mfname  pict; 

'xxxxxxxxxxxxxxxxxxxxxxxxx 1 
9  08,05  say  'Farmer  address:  '  get  maddress  pict; 

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx' 
9  09,05  say  'Farmer  phone*:  *  get  mphoneno  pict; 

'(xxx)xxx-xxxx' 

$  10,05  say  'Contract  date:  '  get  mcontrdate  pict; 

'xx/xx/xx' 

9  11,05  say  'Commodity:  '  get  mcommodity  pict; 

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx' 
9  12,05  say  'Total  shipment:  '  get  mtotalship  pict; 

*9999999999999.99' 

9  13,05  say  'Bales  of  shipment:  '  get  mbalofship  pict; 

'9999999999999.99* 

9  20,05  say  ' — Leave  all  fields  blank,  and  <CR>  to  exit — ' 

*  <  End  of  CONTRAJP.FMT  > 


*  Program  PSHIPIN.FMT - called  from  P_SHIPIN.PRG 

9  02, 01  say  date() 

9  02,15  say  'NEW  PURCHASE  SHIPMENT  DATA  ENTRY  SCREEN' 

®  06,05  say  'Shipment  Number:'  get  mshipno  pict  ‘xxxxxxxxxxxx 

*  07,05  say  ‘Cutting  point  Wgt:  '  get  mcutpntwgt  pict; 

'9999999999999.99' 

9  08,05  say  'Rate  below  cut  point:'  get  mratebcut  pict; 

'9999999999999.99' 

9  09,05  say  'Rate  above  cut  point:'  get  mrateacut  pict; 

'9999999999999  99* 

9  13,15  say  '  NEW  TRUCKS  DATA  ENTRY  SCREEN* 

9  16,05  say  'Date:  '  get  mmthday  pict  'xx/xx/xx' 

9  17,05  say  'Wgt  Ticket  ♦:  '  get  mwgtticket  pict  'xxxxxxxxxxxx' 
9  18,05  say  'Bales:  '  get  mbales  pict  '9999999999999.99' 

9  19,05  say  'Net:  '  get  mnet  pict  '9999999999999.99' 

9  20,05  say  'Trucking  rate  computation  by  shorttons/bales(S/B)'; 

get  mcompute  pict  'x* 

9  23,05  say  ' — Leave  all  fields  blank,  and  <CR>  to  exit — ' 

*  <  End  of  PSHIPIN.FMT  > 


f 


*  Program  TRUCKFMT.FMT - called  from  P-SHIPIN.PRG 

P  02,01  say  dateQ 

p  02, 15  say  *  MORE  TRUCKS  DATA  ENTRY  SCREEN* 

9  03,15  say  ,====================s===================' 

P  05,05  say  ‘Date:  *  get  mmthday  pict  'xx/xx/xx* 

p  06,05  say  'Wgt  Ticket  *  get  mwgtticket  pict  'xxxxxxxxxxxx’ 

p  07,05  say  ‘Bales:  '  get  mbales  pict  '9999999999999. 99 1 

p  08,05  say  ‘Net:  ‘  get  mnet  pict  '9999999999999.99' 

P  23,05  say  ' — Leave  all  fields  blank,  and  <CR>  to  exit — ' 

*  <  End  of  TRUCKFMT.FMT  > 


*  Program  TOFSHIP.FMT - called  from  NEWPURCH.PRG 

P  01,05  say  date() 

P  01,15  say  'TIME  OF  SHIPMENT  DATA  ENTRY  SCREEN' 

P  02,15  say  '===================================' 

P  04,05  say  'Month:  '  get  mmonth  pict  '99' 

*  05,05  say  'Weight:  '  get  mwgt  pict  *9999999999999.99' 

P  06,05  say  'Bales:  '  get  mbal  pict  '9999999999999.99' 

P  07,05  say  'Unit  Price:  ’  get  munitprice  '9999999999999.99' 
p  23,05  say  ' — Leave  all  fields  blank,  and  <CR>  to  exit — ' 

*  <  End  of  TOFSHIP.FMT  > 
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